program make_mosaic
  use gildas_def
  use gkernel_interfaces
  !----------------------------------------------------------------------
  !   Make a mosaic cube from a set of original images.
  !
  ! The original images are assumed to have the same phase tracking center
  ! and hence the same map characterictics (pixel, size, coordinates)
  ! This program compute several images (rather data cubes) :
  !
  ! 'NAME'.LMV  a 3-d cube containing the uniform noise
  !     combined mosaic, i.e. the sum of the product
  !     of the fields by the primary beam.
  ! 'NAME'.LOBE the primary beams pseudo-cube (NF,NX,NY)
  ! 'NAME'.WEIGHT the sum of the square of the primary beams
  ! 'NAME'.BEAM a 3-d cube where each plane is the synthesised
  !     beam for one field
  !
  ! All images have the same X,Y sizes
  ! It is assumed that the names of the original field images follow
  ! the simple sequence 'NAME'-'I'.LMV
  !----------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: version = 'Version 2.0 08-May-2009'
  character(len=*), parameter :: pname = 'MAKE_MOSAIC'
  integer :: nf
  real :: bsize,bmin
  character(len=80) :: generic
  logical :: error
  !
  call gagout('I-'//pname//', '//version)
  !
  call gildas_open
  call gildas_inte('FIELDS$',nf,1)
  call gildas_char('NAME$',generic)
  call gildas_real('BEAM$',bsize,1)
  call gildas_real('BMIN$',bmin,1)
  call gildas_close
  !
  ! Do all the work in a subroutine...
  call sub_mosaic (trim(generic),nf,bsize,bmin,error)
  if (error) call sysexi(fatale)
  call gagout('I-'//pname//',  Successful completion')
  !
end program make_mosaic
!
subroutine sub_mosaic(generic,nf,bsize,bmin,error)
  use gkernel_interfaces
  use image_def
  use mapping_primary
  !
  ! Build a Mosaic from an ensemble of NF initial Images
  ! with a name following the convention name-'i' i=1,nf
  !
  character(len=*), intent(in) :: generic  ! Generic name
  integer, intent(in) :: nf                ! Number of field
  real, intent(in) :: bsize                ! Primary beam size (Radian)
  real, intent(in) :: bmin                 ! Truncation level
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname = 'MAKE_MOSAIC'
  type(gildas) :: field
  type(gildas) :: beam
  type(gildas) :: lobe
  type(gildas) :: mosaic
  type(gildas) :: tmp
  type(gildas) :: weight
  !
  real, allocatable :: dbeam(:,:,:)   ! Dirty and Primary beam arrays
  real, allocatable :: dmosaic(:,:,:) ! Mosaic
  real, allocatable :: dprim(:,:)     ! Current primary beam
  real, allocatable :: dtmp(:,:)      ! Temporary work space
  !
  character(len=filename_length) :: name
  integer :: nx,ny,nv, nn,ier
  integer :: if,iv
  real :: thre, rmin, rmax
  integer(kind=size_length) :: nelem, imin, imax
  character(len=3) :: chain
  !
  call gildas_null(field)
  call gildas_null(beam)
  call gildas_null(lobe)
  call gildas_null(mosaic)
  call gildas_null(weight)
  call gildas_null(tmp)
  !
  error = .false.
  nn = len_trim(generic)
  !
  name = generic
  name(nn+1:) = '-1'
  call sic_parsef (name,field%file,' ','.lmv')
  call gdf_read_header(field,error)
  if (error) then
    write(6,*) 'F-'//rname//',  Cannot open ',field%file
    return
  endif
  nx = field%gil%dim(1)
  ny = field%gil%dim(2)
  nv = field%gil%dim(3)
  !
  ! First pass: Produce the .BEAM Dirty Beam Cube
  call gdf_copy_header(field,beam,error)
  name = generic
  call sic_parsef (name,beam%file,' ','.beam')
  beam%gil%dim(3) = nf
  beam%gil%convert(:,3) = 1.d0
  beam%gil%extr_words = 0
  !
  allocate (dbeam(nx,ny,nf),stat=ier)
  !
  ! Loop over individual synthesized beams
  call gdf_copy_header(field,tmp,error)
  do if=1,nf
    name = generic
    call append_number(name,if)
    call sic_parsef (name,tmp%file,' ','.beam')
    call gdf_read_header (tmp,error)
    if (error) then
      write(6,*) 'F-'//rname//',  Cannot open ',tmp%file
      return
    endif
    if (tmp%gil%dim(1).ne.nx .or. tmp%gil%dim(2).ne.ny) then
      write(6,*) 'F-'//rname//',  Inconsistent size ',tmp%gil%dim
      error = .true.
      return
    endif
    call gdf_read_data(tmp,dbeam(:,:,if),error)
    call gdf_close_image(tmp,error) ! Free image after use
  enddo
  call gdf_write_image(beam,dbeam,error)
  deallocate(dbeam,stat=ier) ! Need and different shape later, so just free it
  if (error) then
    write(6,*) 'F-'//rname//',  Cannot create ',beam%file
    return
  endif
  !
  ! Create the primary beams  -- This is a transposed cube (NF,NX,NY)
  call gdf_transpose_header(beam,lobe,'312',error)
  if (error)  return
  name = generic
  call sic_parsef (name,lobe%file,' ','.lobe')
  !
  lobe%gil%inc(1) = bmin                ! Valeur conventionnelle
  lobe%gil%inc(4) = bsize               ! necessaire pour MRC_MOSAIC.
  allocate (dbeam(nf,nx,ny),dmosaic(nx,ny,nv),dprim(nx,ny),dtmp(nx,ny),stat=ier)  !
  if (ier.ne.0) then
     call gagout('E-'//rname//', Main array allocation error')
     error = .true.
     return
  endif
  !
  ! Create the .LMV cube
  print *,'Noise ',field%gil%noise,field%gil%rms
  call gdf_copy_header(field,mosaic,error)
  print *,'Noise ',mosaic%gil%noise,mosaic%gil%rms
  !
  ! loop over the various fields.
  name = generic(1:nn)
  call sic_parsef (name,mosaic%file,' ','.lmv')
  mosaic%gil%ra = mosaic%gil%a0
  mosaic%gil%dec  = mosaic%gil%d0
  !
  dmosaic = 0
  !
  do if=1,nf
    name = generic
    call append_number(name,if)
    call sic_parsef (name,field%file,' ','.lmv')
    call gdf_read_header (field,error)
    if (error) then
      write(6,*) 'F-'//rname//',  Cannot open ',field%file
      return
    endif
    !
    ! The non truncated primary beam is stored
    call mos_primary (field,dprim,bsize)
    dbeam(if,:,:) = dprim  ! Fill the primary beam array
    !
    ! But a truncated primary beam is used
    where(dprim.lt.bmin) dprim = 0
    !
    ! Make it Plane by Plane to save Memory ...
    do iv=1,nv
      field%blc(3) = iv
      field%trc(3) = iv
      call gdf_read_data (field, dtmp, error)
      dmosaic(:,:,iv) = dmosaic(:,:,iv) + dtmp*dprim  ! Apply the primary beam
    enddo
    call gdf_close_image (field,error) ! Free field image after use
  enddo
  !
  ! Write the primary beams
  call gdf_write_image (lobe,dbeam,error)
  if (error) then
    write(6,*) 'F-'//rname//',  Cannot create ',lobe%file
    return
  endif
  !
  ! Compute the extrema of the Mosaic and write it
  nelem = nx*ny*nv
  call gr4_extrema (nelem,dmosaic,mosaic%gil%bval,mosaic%gil%eval,   &
                    rmin,rmax,imin,imax)
  call t_setextrema(mosaic,rmin,imin,rmax,imax)
  print *,'Noise ',mosaic%gil%noise
  call gdf_write_image(mosaic,dmosaic,error)
  if (error) then
    write(6,*) 'F-'//rname//',  Cannot create ',mosaic%file
    return
  endif
  !
  ! Now the .WEIGHT file
  call gdf_copy_header(mosaic,weight,error)
  weight%gil%ndim = 2
  weight%gil%dim(3) = 1
  name = generic(1:nn)
  call sic_parsef(name,weight%file,' ','.weight')
  !
  ! Use DTMP as temporary space
  dtmp = 0
  call mos_addsq (nx*ny,nf,dtmp,dbeam)
  !
  thre = bmin**2
  call mos_inverse (nx*ny,dtmp,thre)
  nelem = nx*ny
  call gr4_extrema (nelem,dtmp,weight%gil%bval,weight%gil%eval,   &
                    rmin,rmax,imin,imax)
  call t_setextrema(weight,rmin,imin,rmax,imax)
  call gdf_write_image(weight,dtmp,error)
  !
  if (error) then
    write(6,*) 'F-'//rname//',  Cannot create ',weight%file
    return
  endif
end subroutine sub_mosaic

subroutine append_number(name,if)
  character(len=*), intent(inout) :: name
  integer, intent(in) :: if
  !
  character(len=12) :: rchain, lchain
  integer :: nn
  !
  nn = len_trim(name)
  !
  write(rchain,'(I12)') if
  lchain = adjustl(rchain)
  !
  name(nn+1:) = '-'//lchain
end subroutine append_number
