!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! From uv_buffers, we use
!   huv, duv for the UV data set (by READ UV)
!   uvm for the ModelUV data set (by READ 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
!      Read the Model data set
!  FLUX FIND 
!      Define n_dates
!      load Class(n_dates)
!      compute Flux(n_dates)
!      define the associate SIC variable Flux[] and D_Flux
!  FLUX APPLY MyVariable
!      Compute  Fij*ModelUV
!      put it in a SIC variable called MyVariable
!
! Then
!  begin procedure my_proc
!    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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module mapping_flux_scale
  use gbl_message
  !
  public :: flux_scale_comm
  private
  !
  integer :: date_interval=1 
  integer :: n_dates=0                       ! number of dates
  integer, allocatable :: class(:)           ! List of Class dates
  real, allocatable ::  fscale(:)            ! Flux scale factors
  real, allocatable ::  dscale(:)            ! Errors on scale factors
  character(len=70), allocatable :: chain(:) ! Text string per date
  character(len=16) myvar
  real, allocatable :: myuv(:,:)
  !
contains
  !
  subroutine flux_scale_comm(line,error)
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Dispatching routine for command
    !  FLUX FIND DateInterval
    !  FLUX APPLY OutputVariable
    !  FLUX CALIBRATE
    !  FLUX LIST
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    integer :: iarg
    integer, parameter :: mpar=4
    character(len=12) :: arg,argument
    character(12) :: cpar(mpar)
    data cpar /'FIND','APPLY','LIST','CALIBRATE'/ 
    !
    call sic_ke(line,0,1,arg,iarg,.true.,error)
    call sic_ambigs('FLUX',arg,argument,iarg,cpar,mpar,error)
    select case (argument)
    case ('FIND')
       call flux_scale_find(line,error)
    case ('APPLY')
       call flux_scale_apply(line,error)
    case ('LIST') 
       call flux_scale_list(line,error)
    case ('CALIBRATE') 
       call flux_scale_calib(line,error)
    case default
       call gagout(argument//' Not yet implemented')
       error = .true.
    end select
  end subroutine flux_scale_comm
  !   
  subroutine flux_scale_apply(line,error)
    use gkernel_interfaces
    use gildas_def
    use uv_buffers
    !-----------------------------------------------------------
    ! FLUX_SCALE 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
       print *,'Dates not defined, use command 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 (error) return
    !
    if (allocated(myuv)) deallocate(myuv)
    allocate (myuv(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
    nv = huv%gil%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) = uvm%data(:,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_scale_apply
  !
  subroutine flux_scale_calib(line,error)
    use gildas_def
    use uv_buffers
    !-----------------------------------------------------------
    ! FLUX_SCALE 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
       print *,'Dates not defined, use command FLUX FIND before'
       error = .true.
       return
    endif
    !
    allocate (myuv(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
    nv = huv%gil%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_scale_calib
  !
  subroutine flux_scale_find(line,error)
    use gkernel_interfaces
    use gildas_def
    use uv_buffers
    !-----------------------------------------------------------
    ! FLUX FIND DateInterval
    !
    !  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) and compute, through linear regression, the best scaling
    !  factors to match the two tables
    !
    !  Return these flux factors as variables
    !  FLUX and D_FLUX
    !-----------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    logical :: equal
    integer :: ier
    !
    call sic_i4 (line,0,2,date_interval,.true.,error)
    if (error) return
    date_interval = max(1,date_interval) 
    !
    call gdf_compare_shape(huv,uvm%head,equal)
    if (.not.equal) then
       print *,'Data  ',huv%gil%dim
       print *,'Model ',uvm%head%gil%dim 
       call gagout('E-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('FLUX',.false.,error)
       call sic_delvariable('D_FLUX',.false.,error)
    endif
    call flux_scale_factor(huv,duv,uvm%head,uvm%data,date_interval)
    !
    call sic_def_real('FLUX',fscale,1,n_dates,.false.,error)
    call sic_def_real('D_FLUX',dscale,1,n_dates,.false.,error)
  end subroutine flux_scale_find
  !
  subroutine flux_scale_list(line,error)
    !-----------------------------------------------------------
    ! @ private
    !
    ! MAPPING
    ! Support routine for command
    !  FLUX LIST 
    !
    !  printout the latest results from FLUX FIND
    !-----------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    integer :: id
    !
    if (n_dates.eq.0) then
       print *,'Dates not defined, use command FLUX FIND before'
       error = .true.
       return
    endif
    print *,'Summary of observations' 
    print *,'                             Baselines (kLambda)          '
    print *,' Dates      Visibilities       Min   &  Max           Scale'
    do id=1,n_dates
       write(chain(id)(49:),'(F8.3,a,F6.3)') fscale(id),' +/-',dscale(id)
       print *,chain(id)
    enddo
  end subroutine flux_scale_list
  !
  subroutine flux_scale_factor(hduv,duv,hcuv,cuv,date_spacing)
    use image_def
    !-----------------------------------------------------------
    ! 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
    !-----------------------------------------------------------
    integer,       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=8), allocatable :: xy(:), xx(:), yy(:)
    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%dim(2)
    nc = (nm-7)/3
    !
    call find_date(nm,nv,duv,date_spacing,nd) 
    allocate(class(nd),fscale(nd),dscale(nd),chain(nd),stat=ier)
    !
    call list_date(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),stat=ier)
    xx = 0
    xy = 0
    yy = 0
    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_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,iv)**2 + cuv(ii,iv)**2) * cuv(iw,iv)
          xy(id) = xy(id) + (duv(ir,iv)*cuv(ir,iv) + duv(ii,iv)*cuv(ii,iv)) * cuv(iw,iv)
          yy(id) = yy(id) + (duv(ir,iv)**2 + duv(ii,iv)**2) * duv(iw,iv)
       enddo
    enddo
    !
    !! factors = xy/yy  ! Not these ones
    fscale(:) = xy/xx
    dscale = 0.01  
    n_dates = nd
    !
  contains
    !
    subroutine find_date(nc,nv,visi,itol,nt) 
      !-----------------------------------------------------------
      ! 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
      integer, intent(in)  :: itol        ! 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.itol) then
               jt = j
               exit
            endif
         enddo
         if (jt.eq.0) then
            nt = nt+1
            tf(nt) = ti
         endif
      enddo
    end subroutine find_date
    !
    subroutine list_date(nc,nv,visi,nt,tf,itol,chain) 
      use gkernel_interfaces
      !-----------------------------------------------------------
      ! List the different dates 
      !-----------------------------------------------------------
      integer,          intent(in)  :: nc          ! Visibility size 
      integer,          intent(in)  :: nv          ! Number of visibilities
      real,             intent(in)  :: visi(nc,nv) ! Visibilities
      integer,          intent(in)  :: nt          ! Number of time stamps
      integer,          intent(out) :: tf(nt)      ! Time stamp values
      integer,          intent(in)  :: itol        ! Tolerance to check dates 
      character(len=*), intent(out) :: chain(nt)   ! Associated message
      !
      character(len=14) :: ch
      integer :: jt,ti,co,iv,i,j,k
      integer :: it
      integer :: count(nt)
      real :: bmin(nt),bmax(nt),bm,bp,base
      !
      logical error
      !
      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.itol) 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),bmin(i),bmax(i)
      enddo
100   format (A,I8,3X,F9.1,1X,F9.1) 
    end subroutine list_date
  end subroutine flux_scale_factor
end module mapping_flux_scale
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
