module flux_module
  real, save :: date_interval=1.0 
  integer, save :: n_dates=0           ! number of dates
  integer, allocatable :: class(:)     ! List of Class dates
  integer, allocatable :: vgood(:)     ! Number of selected visibilities
  real, allocatable ::  fscale(:)      ! Flux scale factors
  real, allocatable ::  dscale(:)      ! Errors on scale factors
  real, save :: uvmin
  real, save :: uvmax
  character(len=76), allocatable :: chain(:)  ! Text string per date
  character(len=16) myvar
  real, allocatable :: myuv(:,:)
end module flux_module
!
!
! From clean_arrays (requiring clean_def), we use
!   huv, duv for the UV data set (by READ UV)
!   huvm, duvm  for the ModelUV data set (by READ MODEL, or produced
!        by command MODEL)
!
! From flux_variables
!   n_dates      ! number of dates
!   class(:)     ! List of Class dates
!   chain*70(:)  ! Text string per date
!   vscale(:)    ! Flux scale factors
!   dscale(:)    ! Errors on scale factors
!
! Operation
!  
!  READ UV DataSet
!      Read the UV data set
!  READ MODEL DataSet     or MODEL command
!      Read the Model data set
!  SCALE_FLUX FIND 
!      Define n_dates
!      load Class(n_dates)
!      compute Flux(n_dates)
!      define the associate SIC variable Flux[] and D_Flux
!  SCALE_FLUX APPLY MyVariable
!      Compute  Fij*ModelUV
!      put it in a SIC variable called MyVariable
!  SCALE_FLUX
!
! Then, if an iterative procedure is needed:
!  begin procedure my_proc
!    SCALE_FLUX APPLY MyVariable
!    let adj%res UV-MyVariable
!  end procedure my_proc
!  adjust UV "@ my_proc" /start /par flux[i] .. flux[j] /root adj
!  exa adj%fit
!  exa adj%err
!
subroutine flux_dispatch (line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>flux_dispatch
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  ! Dispatching routine for command
  !  SCALE_FLUX FIND [DateInterval [MinBase MaxBase]]
  !  SCALE_FLUX APPLY OutputVariable
  !  SCALE_FLUX CALIBRATE
  !  SCALE_FLUX LIST
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=12) arg, argument
  integer, parameter :: mpar=5
  integer iarg
  character(12) cpar(mpar)
  data cpar /'CALIBRATE', 'APPLY', 'FIND', 'LIST', 'SOLVE'/ 
  !
  call sic_ke(line,0,1,arg,iarg,.true.,error)
  call sic_ambigs('SCALE_FLUX',arg,argument,iarg,cpar,mpar,error)
  select case (argument)
  case ('FIND')
    call flux_find (line,error)
  case ('APPLY')
    call flux_apply (line,error)
  case ('LIST') 
    call flux_list (line,error)
  case ('CALIBRATE') 
    call flux_calib (line,error)
  case ('SOLVE') 
    call flux_find(line,error)
    if (error) return
    call flux_list(line,error)
  case default
     call gagout(argument//' Not yet implemented')
     error = .true.
  end select
end subroutine flux_dispatch
!   
subroutine flux_apply  (line,error)
  use gkernel_interfaces
  use gildas_def
  use clean_arrays
  use flux_module
  use gbl_message
  use imager_interfaces, only : map_message
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for command
  !   SCALE_FLUX APPLY OutputVariable
  !-----------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  integer ier
  integer nc,nv, iv,ic, ir,ii,iw,id,ie, ti
  real weight_fact, flux_fact
  !
  if (n_dates.eq.0) then
    call map_message(seve%e,'SCALE_FLUX','Dates not defined, use command SCALE_FLUX FIND before')
    error = .true.
    return
  endif
  !
  call sic_ch(line,0,2,myvar,ier,.true.,error)
  if (error) return
  call sic_delvariable(myvar,.false.,error)
  !
  if (allocated(myuv)) deallocate(myuv)
  allocate (myuv(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
  nv = huv%gil%nvisi ! not %dim(2)
  nc = huv%gil%nchan 
  id = 1
  !
  do iv=1,nv
    !
    ! Get the date
    ti = int(duv(4,iv)+duv(5,iv)/86400.0d0)     
    if (ti.eq.0 .and. duv(6,iv).eq.0) cycle  ! Dummy
    if (abs(ti-class(id)).ge.date_interval) then
      do ie=1,n_dates 
        if (abs(ti-class(ie)).lt.date_interval) then
          id = ie
          exit
        endif
      enddo
    endif
    flux_fact =  fscale(id) 
    weight_fact = 1./flux_fact**2
    myuv(:,iv) = duvm(:,iv)
    do ic=1,nc
      ir = 5+3*ic
      ii = ir+1
      iw = ii+1
      !
      myuv(ir,iv) = myuv (ir,iv) * flux_fact 
      myuv(ii,iv) = myuv (ii,iv) * flux_fact 
      myuv(iw,iv) = myuv (iw,iv) * weight_fact 
    enddo
  enddo
  call sic_def_real(myvar,myuv,2,huv%gil%dim,.true.,error)
end subroutine flux_apply
!
subroutine flux_calib (line,error)
  use gildas_def
  use clean_arrays
  use flux_module
  use gbl_message
  use imager_interfaces, only : map_message
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  ! Support for command
  !  SCALE_FLUX CALIBRATE 
  !
  ! Apply the factors to the UV data set..
  !-----------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  integer ier
  integer nc,nv, iv,ic, ir,ii,iw,id,ie, ti
  real weight_fact, flux_fact
  !
  if (n_dates.eq.0) then
    call map_message(seve%e,'SCALE_FLUX','Dates not defined, use command SCALE_FLUX FIND before')
    error = .true.
    return
  endif
  !
  allocate (myuv(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
  nv = huv%gil%nvisi ! not %dim(2)
  nc = huv%gil%nchan 
  id = 1
  !
  do iv=1,nv
    !
    ! Get the date
    ti = int(duv(4,iv)+duv(5,iv)/86400.0d0)     
    if (ti.eq.0 .and. duv(6,iv).eq.0) cycle  ! Dummy
    if (abs(ti-class(id)).ge.date_interval) then
      do ie=1,n_dates 
        if (abs(ti-class(ie)).lt.date_interval) then
          id = ie
          exit
        endif
      enddo
    endif
    flux_fact =  1./fscale(id) 
    weight_fact = flux_fact**2
    do ic=1,nc
      ir = 5+3*ic
      ii = ir+1
      iw = ii+1
      !
      duv(ir,iv) = duv (ir,iv) * flux_fact 
      duv(ii,iv) = duv (ii,iv) * flux_fact 
      duv(iw,iv) = duv (iw,iv) * weight_fact 
    enddo
  enddo
end subroutine flux_calib
!
subroutine flux_find (line,error)
  use gkernel_interfaces
  use gildas_def
  use clean_arrays
  use flux_module
  use gbl_message
  use imager_interfaces, only : flux_factor, map_message
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  ! Support routine for command
  !  SCALE_FLUX FIND [DateInterval [MinBase MaxBase]]
  !
  !  Scan the current UV table (obtained by READ UV) to determine
  !  how many independent dates exist
  !
  !  Compare it date by date with the model UV table (obtained by 
  !  READ MODEL or MODEl commands) and compute, through linear 
  !  regression, the best scaling factors to match the two tables
  !
  !  Return these flux factors as variables
  !  SCALE_FLUX and D_FLUX
  !-----------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  logical equal
  integer ier
  real uvmin2
  real uvmax2
  !
  date_interval = 1.0
  call sic_r4 (line,0,2,date_interval,.false.,error)
  if (error) return
  if (date_interval.le.0) then
    call map_message(seve%e,'SCALE_FLUX','Date tolerance must be > 0')
    error = .true.
    return
  endif  
  !
  uvmin = 0
  uvmax = 0
  call sic_r4(line,0,3,uvmin,.false.,error)
  call sic_r4(line,0,4,uvmax,.false.,error)
  uvmin2 = uvmin**2
  uvmax2 = uvmax**2
  !
  call gdf_compare_shape(huv,huvm,equal)
  if (.not.equal) then
    print *,'Data  ',huv%gil%dim
    print *,'Model ',huvm%gil%dim 
    call map_message(seve%e,'SCALE_FLUX','Data and Model are not comparable')
    error = .true.
    return
  endif
  if (n_dates.ne.0) then
    deallocate(class,fscale,dscale,chain,stat=ier)
    n_dates = 0
    call sic_delvariable('S_FLUX',.false.,error)
    call sic_delvariable('D_FLUX',.false.,error)
  endif
  call flux_factor (huv,duv,huvm,duvm,date_interval,uvmin2,uvmax2,error)
  if (error) return
  !
  call sic_def_real('S_FLUX',fscale,1,n_dates,.false.,error)
  call sic_def_real('D_FLUX',dscale,1,n_dates,.false.,error)
end subroutine flux_find
!
subroutine flux_list (line,error)
  use flux_module
  use gbl_message
  use imager_interfaces, only : flux_factor
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  ! Support routine for command
  !  SCALE_FLUX LIST 
  !
  !  Printout the latest results from SCALE_FLUX FIND
  !-----------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  integer id
  !
  if (n_dates.eq.0) then
    call map_message(seve%e,'SCALE_FLUX','Dates not defined, use command SCALE_FLUX FIND before')
    error = .true.
    return
  endif
  write(*,'(A)')  &
    &     ' Summary of observations              Baselines (m) '
  Print *,' Dates          Visibilities           Min   &  Max           Scale'
  write(*,'(A,I8,A,I8,A)')  &
    &     '              Total     In range   [',nint(uvmin),", ",nint(uvmax),']'
  do id=1,n_dates
    write(chain(id)(24:31),'(I8)') vgood(id)
    write(chain(id)(57:),'(F8.3,a,F6.3)') fscale(id),' +/-',dscale(id)
    print *,chain(id)
  enddo
end subroutine flux_list
!
subroutine flux_factor (hduv,duv,hcuv,cuv,date_spacing,uvmin2,uvmax2,error)
  use imager_interfaces, only : my_finddat, my_listdat
  use flux_module
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   SCALE_FLUX FIND or SOLVE
  ! Find the flux scale factors for the Observations
  !
  ! The observations are defined by  Obs = Factor * Model + noise
  ! so the calibration factor to apply is the inverse of this solution
  !-----------------------------------------------------------
  real(kind=4), intent(in) :: date_spacing
  type (gildas), intent(in) :: hduv
  type (gildas), intent(in) :: hcuv
  real(kind=4), intent(in) :: duv(hduv%gil%dim(1),hduv%gil%dim(2))
  real(kind=4), intent(in) :: cuv(hcuv%gil%dim(1),hcuv%gil%dim(2))
  real(kind=4), intent(in) :: uvmin2 ! Min baseline ^ 2
  real(kind=4), intent(in) :: uvmax2 ! Max baseline ^ 2
  logical, intent(out) :: error
  !
  real(kind=8), allocatable :: xy(:), xx(:), yy(:), xm(:)
  integer, allocatable :: im(:)
  real :: uv2
  integer :: nm,nv,nc,nd
  integer :: id, ie, iv, ic, ti, ier
  integer :: ii, ir, iw
  !
  ! 3) Build list of dates
  nm = hduv%gil%dim(1)
  nv = hduv%gil%nvisi ! Not %dim(2)
  nc = hduv%gil%nchan ! not (nm-7)/3
  !
  call my_finddat (nm,nv,duv,date_spacing,nd) 
  allocate(class(nd),fscale(nd),dscale(nd),chain(nd),vgood(nd),stat=ier)
  !
  call my_listdat (nm,nv,duv,nd,class,date_spacing,chain) 
  !
  ! 4) Linear fit of flux scale factor
  !
  ! A = Sum (X Y / sigma^2) / Sum (X^2/Sigma^2)
  ! A = Sum (X Y W) / Sum (X X W)
  !
  allocate (xy(nd),xx(nd),yy(nd),xm(nd),im(nd),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,'UV_FLUX','Memory allocation error')
    error = .true.
    return
  endif
  xx = 0
  xy = 0
  yy = 0
  xm = 0
  im = 0
  id = 1
  !
  do iv=1,nv
    ! Avoid UV out of range
    if (uvmin2.ne.0 .or. uvmax2.ne.0) then
      uv2 = duv(1,iv)**2 + duv(2,iv)**2
      if (uv2.le.uvmin2) cycle
      if (uvmax.ne.0) then
        if (uv2.gt.uvmax2) cycle
      endif
    endif
    !
    ! Get the date
    ti = int(duv(4,iv)+duv(5,iv)/86400.0d0)     
    if (ti.eq.0 .and.duv(6,iv).eq.0) cycle !! Dummy
    if (abs(ti-class(id)).ge.date_spacing) then
      id = 0
      do ie=1,nd 
        if (abs(ti-class(ie)).lt.date_spacing) then
          id = ie
          exit
        endif
      enddo
    endif
    !
    do ic=1,nc
      ir = 5+3*ic
      ii = ir+1
      iw = ii+1
      xm(id) = xm(id) + cuv(ir,iv) + cuv(ii,iv) ! needed later
      im(id) = im(id) + 1
      xx(id) = xx(id) + (cuv(ir,iv)**2 + cuv(ii,iv)**2) * cuv(iw,iv)**2
      xy(id) = xy(id) + (duv(ir,iv)*cuv(ir,iv) + duv(ii,iv)*cuv(ii,iv)) * cuv(iw,iv)**2
      yy(id) = yy(id) + (duv(ir,iv)**2 + duv(ii,iv)**2) * duv(iw,iv)**2
    enddo
  enddo
  if (any(im.lt.3)) then
    call map_message(seve%e,'SCALE_FLUX','Not enough visibilities in range')
    error = .true.
    return
  endif
  xm(:) = xm/im
  !
  !! factors = xy/yy  ! Not these ones
  fscale(:) = xy/xx   ! XX is the model
  !! Standard deviation, equal weights to have an idea
  !! sqrt [ Σ(yi – ŷi)^2 / (n – 2) ] / sqrt [ Σ(xi – x)^2 ].
  !!  with ŷi =0 and x=0 
  xx = 0
  yy = 0
  do iv=1,nv
    ! Avoid UV out of range
    if (uvmin2.ne.0 .or. uvmax2.ne.0) then
      uv2 = duv(1,iv)**2 + duv(2,iv)**2
      if (uv2.le.uvmin2) cycle
      if (uvmax2.ne.0) then
        if (uv2.gt.uvmax2) cycle
      endif
    endif
    !
    ! Get the date
    ti = int(duv(4,iv)+duv(5,iv)/86400.0d0)     
    if (ti.eq.0 .and.duv(6,iv).eq.0) cycle !! Dummy
    if (abs(ti-class(id)).ge.date_spacing) then
      do ie=1,nd 
        if (abs(ti-class(ie)).lt.date_spacing) then
          id = ie
          exit
        endif
      enddo
    endif
    !
    do ic=1,nc
      ir = 5+3*ic
      ii = ir+1
      iw = ii+1
      !
      xx(id) = xx(id) + (cuv(ir,ic)-xm(id))**2 + (cuv(ii,ic)-xm(id))**2
      yy(id) = yy(id) + (duv(ir,ic)-fscale(id)*cuv(ir,ic))**2 + &
          & (duv(ii,ic)-fscale(id)*cuv(ii,ic))**2
    enddo
  enddo
  vgood(:) = im
  dscale(:) = sqrt(yy/(vgood-2)/xx)  
  n_dates = nd
  error = .false.
end subroutine flux_factor
!
subroutine my_finddat(nc,nv,visi,rtol,nt) 
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Find how many dates
  !-----------------------------------------------------------
  integer, intent(in) :: nc  ! Visibility size 
  integer, intent(in) :: nv  ! Number of visibilities
  integer, intent(out) :: nt ! Number of time stamps
  real, intent(in) :: rtol  ! Tolerance to check dates 
  real, intent(in) :: visi(nc,nv)   ! Visibilities
  !
  integer iv
  integer ti,jt,j
  integer tf(nv)
  !
  nt = 0
  do iv=1,nv
    ti = int(visi(4,iv)+visi(5,iv)/86400.0d0)
    if (ti.eq.0 .and.visi(6,iv).eq.0) cycle !! Dummy
    jt = 0
    do j=1,nt
      if (abs(ti-tf(j)).lt.rtol) then
        jt = j
        exit
      endif
    enddo
    if (jt.eq.0) then
      nt = nt+1
      tf(nt) = ti
    endif
  enddo
end subroutine my_finddat
!
subroutine my_listdat(nc,nv,visi,nt,tf,rtol,chain) 
  use gkernel_interfaces
  !-----------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   List the different dates 
  !-----------------------------------------------------------
  integer, intent(in) :: nc  ! Visibility size 
  integer, intent(in) :: nv  ! Number of visibilities
  integer, intent(in) :: nt  ! Number of time stamps
  integer, intent(out) :: tf(nt)              ! Time stamp values
  character(len=*), intent(out) :: chain(nt)  ! Associated message
  real, intent(in) :: rtol  ! Tolerance to check dates 
  real, intent(in) :: visi(nc,nv)   ! Visibilities
   !
  character(len=14) ch
  logical error
  integer jt,ti,co,iv,i,j,k
  integer it
  integer count(nt)
  real bmin(nt), bmax(nt), bm, bp, base
  !
  it = 0
  tf = 0
  bmin = 1E20
  bmax = 0
  !
  !!Print *,'Date Tolerance ',itol
  !
  do iv=1,nv
    ti = int(visi(4,iv)+visi(5,iv)/86400.0d0)
    if (ti.eq.0 .and.visi(6,iv).eq.0) cycle !! Dummy
    jt = 0
    do j=1,nt
      if (abs(ti-tf(j)).lt.rtol) then
        jt = j
        exit
      endif
    enddo
    if (jt.eq.0) then
      if (it.gt.nt) then
        print *,'E-DATES,  more than ',nt,' dates'
        return
      endif
      it = it+1
      tf(it) = ti
      count(it) = 1
      jt = it
    else
      count(jt) = count(jt)+1
    endif
    !
    base = visi(1,iv)**2+visi(2,iv)**2
    if (base.ne.0) then
      bmin(jt) = min(base,bmin(jt))
      bmax(jt) = max(base,bmax(jt))
    endif
  enddo
  !
  ! Go to true baseline length
  bmin = sqrt(bmin)
  bmax = sqrt(bmax)
  !
  !
  ! A simple sort
  do j = nt-1,1,-1
    k = j
    do i = j+1,nt
      if (tf(j).le.tf(i)) exit 
      k = i
    enddo
    if (k.ne.j) then
      ti = tf(j)
      co = count(j)
      bp = bmax(j)
      bm = bmin(j)     
      do i = j+1,k
        tf(i-1) = tf(i)
        count(i-1) = count(i)
        bmax(i-1) = bmax(i)
        bmin(i-1) = bmin(i)
      enddo
      tf(k) = ti
      count(k) = co
      bmax(k) = bp
      bmin(k) = bm
    endif
  enddo
  !
  do i=1,nt
    call gag_todate(tf(i),ch,error)
    write(chain(i),100) ch,count(i),count(i),bmin(i),bmax(i)
  enddo
100 format (A,I8,1X,I8,3X,F9.1,1X,F9.1) 
end subroutine my_listdat


