!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure setup-size
  define integer ounpix[2]
  define double size[2] cell[2]
  let size &1
  let cell &2
  !
  ! Formula by rounding
  define integer poweroftwo[2] npix[2,3] jtry
  define double dist[2,3]
  let poweroftwo (ceiling(log(size/cell)/log(2.)))
  let npix[1] 2**poweroftwo
  let npix[2] 2**(poweroftwo-2)*3
  let npix[3] 2**(poweroftwo-3)*5
  let dist[1] npix[1]*cell-size
  let dist[2] npix[2]*cell-size
  let dist[3] npix[3]*cell-size
  let jtry 1
  for itry 2 to 3
     if ((dist[1,itry].ge.0).and.(dist[1,itry].le.dist[1,jtry])) let jtry itry
  next ! itry
  let ounpix[1] npix[1,jtry]
  let jtry 1
  for itry 2 to 3
     if ((dist[2,itry].ge.0).and.(dist[2,itry].le.dist[2,jtry])) let jtry itry
  next ! itry
  let ounpix[2] npix[2,jtry]
  !
  ! Ensure a minimum map size of 64 pixels (***JP: 40 provokes a segfault)
  let ounpix max(64,ounpix)
  !
  let &3 ounpix
end procedure setup-size
!
begin procedure setup-inter
  message d setup "Calling setup-inter"
  !
  define logical redo
  define character filename*512
  let filename 'name'".uvt"
  !
  ! Test if already loaded
  let redo yes
  if (exist(&1)) then
    if (exist(&1%int)) then
      if (name.eq.&1%int%name) then
        if (file(filename)) then
          define long newdate  ! Long => compute nanosecond date
          sic\compute newdate date 'filename'
          if (newdate.eq.&1%int%date) then
            let redo no
          endif
        endif
      endif
    endif
  endif
  if (redo) then
     if exist(&1) delete /var &1
     define structure &1 /global
     define structure &1%int /global
     define long      &1%int%date /global  ! Long => nanosecond date
     define character &1%int%name*256 /global
     define logical &1%int%mosaic /global
     define integer &1%int%first &1%int%last /global
     define double  &1%int%diam &1%int%restfreq &1%int%hppb /global
     define integer &1%int%nf /global
     ! Recommended and Used field ["], size [Pixel], cell("), (trc, blc) [pixels]
     define structure &1%reco /global
     define double &1%reco%field[2] &1%reco%cell[2] /global
     define integer &1%reco%size[2] &1%reco%trc[2] &1%reco%blc[2] /global
     define structure &1%used /global
     define double &1%used%field[2] &1%used%cell[2] /global
     define integer &1%used%size[2] &1%used%trc[2] &1%used%blc[2] /global
  endif
  !
  ! Search for obs kind (single field or mosaic) and number of field (&1%int%nf)
  let filename 'name'".uvt"
  if (file(filename)) then
     sic\compute &1%int%date date 'filename'
     clean\read uv 'filename'
  else
     ! Maybe this is an old-style mosaic
     sic find 'name'"-[0-9]*.uvt"  ! sh-compatible
     if (dir%nfile.ne.0) then
        @ p_collect-fields.map
        clean\read uv 'filename'
     else
        message e setup "Do not find file either "'name'".uvt or " 'name'"-*.uvt"
        return base
     endif
  endif
  ! *** The lines of this block need to be done only now to avoid duplication of codes
  let &1%int%name 'name'
  if exist(fields) then
     clean\mosaic on
     let &1%int%mosaic yes
     let &1%int%nf abs(fields%n) ! < 0 value for LM mosaic and > 0 value for XY mosaic
  else
     clean\mosaic off
     let &1%int%mosaic no
     let &1%int%nf 1
  endif
  ! ***
  !
  ! Check the presence of the telescope section
  if (uv%ntel.eq.0) then
     message e setup "Missing telescope section in "'filename'
     message e setup "Use first: GO TELES noema|alma|aca|..."
     let type uvt
     return base
  else if (uv%ntel.gt.1) then
     message w setup "More than one telescope defined in header"
     message w setup "I will use the first one to define the interferometer diameter: "'uv%tel1%name'
  endif
  !
  ! Number of pixels per beam
  define real pixel_per_beam
  let pixel_per_beam 5
  !
  if (redo) then
     define structure &1%int%ra &1%int%dec &1%int%a0 &1%int%d0 &1%int%pa /global
     define structure &1%int%cent &1%int%size &1%int%cell /global
     define double &1%int%ra%rad[&1%int%nf] &1%int%dec%rad[&1%int%nf] /global
     define double &1%int%a0%rad[&1%int%nf] &1%int%d0%rad[&1%int%nf] &1%int%pa%rad[&1%int%nf] /global
     define double &1%int%uvmax &1%int%uvmin &1%int%cell%rad &1%int%cell%sec /global
     define character &1%int%cent%sex*16[2] /global
     define double &1%int%cent%rad[2] /global
     define double &1%int%size%rad[2] &1%int%size%sec[2] /global
     define integer &1%int%size%pix[2] /global
     define double &1%int%uvampmax /global
     define integer &1%int%nvisi[&1%int%nf] /global
     define double min max obsfreq imrange[4]
     !
     ! Observing frequencies, telescope diameter, primary beamwidth
     let obsfreq 'uv%convert[2,1]/1000.' ! [GHz] Frequency
     let &1%int%restfreq 'uv%restfre/1000.' ! [GHz] Frequency
     let &1%int%diam 'uv%tel1%diam'
     if (uv%major.ne.0) then
        let &1%int%hppb 'uv%major' ! [rad] Primary beam size
     else if exist(fields) then
        let &1%int%hppb fields%primary
     else
        let &1%int%hppb '63.0*sec*(12.0/&1%int%diam)*(100.0/obsfreq)' ! [rad] Primary beam size
     endif
     !
     ! Field absolute positions in uv table and field of view
     if (mosaic) then
        sic\compute min min fields%offsets[1,]
        sic\compute max max fields%offsets[1,]
        let imrange[1:2] 'min' 'max'
        sic\compute min min fields%offsets[2,]
        sic\compute max max fields%offsets[2,]
        let imrange[3:4] 'min' 'max'
        !
        let &1%int%ra%rad  uv%a0+fields%offsets[1,]/cos(uv%d0) ! [rad] Field center RA
        let &1%int%dec%rad uv%d0+fields%offsets[2,] ! [rad] Field center Dec
     else
        let imrange 0.0
        let &1%int%ra%rad  uv%a0
        let &1%int%dec%rad uv%d0
     endif
     !
     ! Baseline range
     define real uvdist['uv%dim[2]']
     let uvdist sqrt(uv[1,]^2+uv[2,]^2)
     sic\compute &1%int%uvmax max uvdist
     sic\compute &1%int%uvmin min uvdist
     delete /var uvdist
     ! Defines first and last used channels
     if (first.eq.0) then
        let &1%int%first 1
     else
        let &1%int%first 'first'
     endif
     if (last.eq.0) then
        let &1%int%last 'uv%nchan'
     else
        let &1%int%last 'last'
     endif
     !
     ! Compute cell size, ie put PIXEL_PER_BEAM cells per synthesized beam and convert it in radian
!!$     define double factor uv0 uv1
!!$     let uv0 200
!!$     let uv1 800
!!$     if (&1%int%uvmax.lt.uv0) then
!!$        let factor 1
!!$     else if ((uv0.le.&1%int%uvmax).and.(&1%int%uvmax.lt.uv1)) then
!!$        let factor 1+((&1%int%uvmax-uv0)/(uv1-uv0))^0.3
!!$     else
!!$        let factor 2
!!$     endif
!!$     let &1%int%cell%sec factor*299792458.d-9/(&1%int%uvmax*&1%int%restfreq)
     let &1%int%cell%sec 299792458.d-9/(&1%int%uvmax*&1%int%restfreq)
     if (&1%int%cell%sec.gt.0.01) then
        let &1%int%cell%sec 0.01*nint(100.0*&1%int%cell%sec/pixel_per_beam/sec)
     else
        let &1%int%cell%sec 0.0001*nint(10000.0*&1%int%cell%sec/pixel_per_beam/sec)
     endif
     let &1%int%cell%rad &1%int%cell%sec*sec
     !
     ! Compute projection center and convert into sexagesimal format
     if (uv_shift.eq.yes) then
        let &1%int%cent%sex[1] 'map_ra'
        let &1%int%cent%sex[2] 'map_dec'
        let &1%int%cent%rad[1] 'map_ra'  /sexa
        let &1%int%cent%rad[1] &1%int%cent%rad[1]*pi/12.0
        let &1%int%cent%rad[2] 'map_dec' /sexa
        let &1%int%cent%rad[2] &1%int%cent%rad[2]*pi/180.0
     else
        let &1%int%cent%rad[1] uv%a0
        let &1%int%cent%rad[2] uv%d0
        @ l-rad2ra.map  &1%int%cent%sex[1] '&1%int%cent%rad[1]'
        @ l-rad2dec.map &1%int%cent%sex[2] '&1%int%cent%rad[2]'
     endif
     !
     ! Compute the mosaic field-of-view and convert in arcsec and in pixel
     let &1%int%size%rad[1] (imrange[2]-imrange[1]) ! *** JP  *cos(&1%int%cent%rad[2])
     let &1%int%size%rad[2] (imrange[4]-imrange[3])
     !
     ! This uses hppb as width of the bandguard around the size of the mosaic pointings
     let &1%int%size%rad &1%int%size%rad+2*&1%int%hppb
     !
     ! UV_MAP uses the minimum baseline, which is appropriate for Single Field
     ! without short spacings. See the below commented formula. However
     ! short spacings can exist. Thus we do not use it here.
     ! Note: there is an extra guard band by a factor 2 in the rounding below
     ! let &1%int%size%rad &1%int%size%rad+&1%int%uvmax/&1%int%uvmin*pixel_per_beam*&1%int%cell%sec*sec/2
     !
     let &1%int%size%sec &1%int%size%rad/sec
     @ setup-size  &1%int%size%sec  &1%int%cell%sec  &1%int%size%pix
     !
     ! Compute field offsets after shifting when required by user
     define structure &1%int%xoff &1%int%yoff /global
     define double &1%int%xoff%rad[&1%int%nf] &1%int%yoff%rad[&1%int%nf] /global
     define double &1%int%xoff%sec[&1%int%nf] &1%int%yoff%sec[&1%int%nf] /global
     for ifield 1 to &1%int%nf
        let &1%int%xoff%rad[ifield] (&1%int%ra%rad[ifield]-&1%int%cent%rad[1])*cos(&1%int%dec%rad[ifield])
        let &1%int%yoff%rad[ifield] (&1%int%dec%rad[ifield]-&1%int%cent%rad[2])
        let &1%int%xoff%sec[ifield] &1%int%xoff%rad[ifield]/sec
        let &1%int%yoff%sec[ifield] &1%int%yoff%rad[ifield]/sec
     next ifield
  endif ! redo
  !
  let &1%reco%cell  &1%int%cell%sec
  let &1%reco%size  &1%int%size%pix
  let &1%reco%field &1%int%size%pix*&1%int%cell%sec
  let &1%used% &1%reco%
  if (map_field[1].ne.0) then
     ! Replace the field of view by its user specification
     let &1%used%size  map_field/&1%reco%cell
     ! Round to power of two
     let &1%used%size 2^nint(log(&1%used%size)/log(2))
     ! Adjust pixel size
     let &1%used%cell sqrt(map_field[1]*map_field[2]/&1%used%size[1]/&1%used%size[2])
  else
     ! Use further specifications if needed...
     if (map_cell[1].ne.0) then
        let &1%used%cell[1] map_cell[1]
     endif
     if (map_cell[2].ne.0) then
        let &1%used%cell[2] map_cell[2]
     endif
     if ((map_size[1].ne.0).and.(map_size[2].ne.0)) then
        let &1%used%size[1] map_size[1]
        let &1%used%size[2] map_size[2]
     else
        @ setup-size &1%int%size%sec  &1%used%cell  &1%used%size
     endif
  endif
  let &1%used%field &1%used%size*&1%used%cell
  !
  ! Adapt blc,trc according to specifications *** JP: Some user feedback would be welcome
  if (mosaic) then
     define integer nedge[2]
     let nedge &1%int%hppb/(2*&1%used%cell*sec)
     let &1%reco%blc nedge
     let &1%reco%trc &1%used%size-nedge
  else
     let &1%reco%blc &1%used%size/4+1
     let &1%reco%trc &1%used%size*3/4
  endif
  if ((blc[1].eq.0).or.(blc[2].eq.0).or.(trc[1].eq.0).or.(trc[2].eq.0)) then
     let &1%used%blc &1%reco%blc
     let &1%used%trc &1%reco%trc
  else
     let &1%used%blc blc
     let &1%used%trc trc
  endif
  !
  ! User feedback
  say " "
  say "Input file: Interferometer ("'&1%int%diam'"m)  "'filename'
  say " "
  if (&1%int%mosaic) then
     say "   Number of fields in mosaic   "'&1%int%nf'"  ("'uv%nvisi'" visibilities)"
     say " "
     say "   Field    RA offset   DEC offset    Nvisi"
     for ifield 1 to &1%int%nf
        say "    " 'ifield' "      " '&1%int%xoff%sec[ifield]' "      " '&1%int%yoff%sec[ifield]' "      " '&1%int%nvisi[ifield]' /format a4 i3 a6 f6.1 a6 f6.1 a6 i6
     next ifield
  else
     say "   Single field observation ("'uv%nvisi'" visibilities)"
  endif
  say " "
  say "   Observed rest frequency       "'&1%int%restfreq'" GHz"
  say "   Half power primary beam       "'nint(10*&1%int%hppb/sec)/10'" arcsec"
  say "   Phase center RA and Dec       "'&1%int%cent%sex[1]'" "'&1%int%cent%sex[2]'
  say "   Field of view / Largest Scale "'nint(10*&1%int%size%sec[1])/10'" x "'nint(10*&1%int%size%sec[2])/10'" arcsec"
  say " "
  !
  say "                                Recommended        Used"
  define integer mymcol[2] nchan
  let mymcol mcol
  if mymcol[1].eq.0  let mymcol[1] 1
  if mymcol[2].eq.0  let mymcol[2] uv%nchan
  let nchan mymcol[2]-mymcol[1]+1
  say "   Spectral axis size              "'uv%nchan'"            "'nchan'" channels"
  say "   Map size                      "'&1%reco%size[1]'" x "'&1%reco%size[2]'"       "'&1%used%size[1]'" x "'&1%used%size[2]'" pixels"
  define character unit*16
  define double reco[2] used[2]
  let reco &1%reco%cell
  let used &1%used%cell
  if ((used[1].ge.0.1).and.(used[2].ge.0.1)) then
     let used nint(used*100)/100
     let reco nint(reco*100)/100
     let unit "arcsec"
  else
     let used nint(used*1000)/1000
     let reco nint(reco*1000)/1000
     let unit "milliarcsec"
  endif
  say "   Map cell                      "'reco[1]'" x "'reco[2]'"       "'used[1]'" x "'used[2]'" arcsec"
  let reco &1%reco%field
  let used &1%used%field
  if ((used[1].ge.0.1).and.(used[2].ge.0.1)) then
     let used nint(used*10)/10
     let reco nint(reco*10)/10
     let unit "arcsec"
  else
     let used nint(used*1000)/1000
     let reco nint(reco*1000)/1000
     let unit "milliarcsec"
  endif
  say "   Image size                  "'reco[1]'" x "'reco[2]'"   "'used[1]'" x "'used[2]'" arcsec"
  define double cubesize[2] ramsize
  let cubesize[1] &1%reco%size[1]*&1%reco%size[2]*uv%nchan*4  ! [Bytes]
  let cubesize[2] &1%used%size[1]*&1%used%size[2]*nchan*4  ! [Bytes]
  if any(cubesize.gt.1.099E+12) then
    let cubesize cubesize/1.099E+12
    let ramsize sic%ramsize/1.049E+06  ! MiB to TiB
    let unit "TiB"
  else if any(cubesize.gt.1.074E+09) then
    let cubesize cubesize/1.074E+09
    let ramsize sic%ramsize/1.024E+03  ! MiB to GiB
    let unit "GiB"
  else if any(cubesize.gt.1.049E+06) then
    let cubesize cubesize/1.049E+06
    let ramsize sic%ramsize  ! MiB
    let unit "MiB"
  else if any(cubesize.gt.1.024E+03) then
    let cubesize cubesize/1.024E+03
    let ramsize sic%ramsize*1.024E+03  ! MiB to kiB
    let unit "kiB"
  else
    let ramsize sic%ramsize*1.049E+06  ! MiB to B
    let unit "B"
  endif
  let cubesize nint(cubesize*10)/10
  say "   Cube size                        "'cubesize[1]'"            "'cubesize[2]'" "'unit'
  if (sic%ramsize.gt.0) then
     if (cubesize[2].gt.ramsize/4) then
        say "   WARNING! Desired cube size exceeds 25% of the total RAM size"
     endif
  endif
  say "   X-axis clean searched range    "'&1%reco%blc[1]'" - "'&1%reco%trc[1]'"        "'&1%used%blc[1]'" - "'&1%used%trc[1]'" pixels"
  say "   Y-axis clean searched range    "'&1%reco%blc[2]'" - "'&1%reco%trc[2]'"        "'&1%used%blc[2]'" - "'&1%used%trc[2]'" pixels"
  !
  ! Poll imaging state
  say " "
  let filename 'name'".lmv"
  if file(filename) then
     let type lmv
     say "   Already imaged"
     let filename 'name'".beam"
     if .not.file(filename) then
        say "   But the dirty beam file is missing"
     endif
     if (&1%int%mosaic) then
        let filename 'name'".lobe"
        if .not.file(filename) then
           say "   But the primary beam file is missing"
        endif
        let filename 'name'".fields"
        if .not.file(filename) then
           say "   But the fields file is missing"
        endif
     endif
  else
     say "   Still to be imaged"
  endif
  !
  ! Poll deconvolution state
  if (type.ne."lmv-clean") then
     let filename 'name'".lmv-clean"
     if file(filename) then
        let type lmv-clean
        say "   Already cleaned"
     else
        say "   Still to be cleaned"
     endif
  endif
  !
end procedure setup-inter
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure setup-sd
  if (exist(&1)) then
     if (exist(&1%sd)) then
       delete /var &1%sd
     endif
  else
     define structure &1 /global
  endif
  !
  ! Search for input file
  define character filename*512
  define logical found
  let found no
  let filename 'name'"-short.lmv"
  if (file(filename)) then
     let found yes
  else
     let filename 'name'".tab"
     if file(filename) let found yes
  endif
  !
  if (found) then
     ! Define the structure
     define structure &1%sd /global
     define character &1%sd%name*256 &1%sd%unit*12 /global
     define double &1%sd%obsfreq &1%sd%diam &1%sd%hppb /global
     ! Fill the structure
     let &1%sd%name 'name'
     define header sdin 'filename' read
     let &1%sd%unit 'sdin%unit'
     let &1%sd%obsfreq sdin%restfre/1000 ! [GHz] Frequency
     ! Check the presence of the telescope section
     if (sdin%ntel.eq.0) then
        message e setup "Missing telescope section in "'filename'
        message e setup "Use first: GO TELES 30m|..."
        let type tab
        return base
     else if (sdin%ntel.gt.1) then
        message w setup "More than one telescope defined in header"
        message w setup "I will use the first one to define the single-dish diameter: "'sdin%tel1%name'
     endif
     let &1%sd%diam sdin%tel1%diam
     ! Get primary beam size from the beam section
     if (sdin%major.ne.0) then
        let &1%sd%hppb 'sdin%major' ! [rad] Primary beam size
     else
        let &1%sd%hppb '63.0*sec*(12.0/&1%sd%diam)*(100.0/&1%sd%obsfreq)' ! [rad] Primary beam size
     endif
     delete /var sdin
     ! User feedback
     say " "
     say "Input file: Single-dish ("'&1%sd%diam'"m)   "'filename'
     say " "
     say "   Observed frequency           "'&1%sd%obsfreq'" GHz"
     say "   Half power beam size         "'&1%sd%hppb/sec'" arcsec"
     say "   Intensity unit               "'&1%sd%unit'
     ! Poll merged state
     say " "
     let filename 'name'"-merged.lmv"
     if file(filename) then
        say "   Already merged"
     else
        say "   Still to be merged"
     endif
  endif
  !
end procedure setup-sd
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Check name and type variables
@ p_name.greg "name"
!
! Get optional name of setup structure
define character setup_name*32
if (pro%narg.ge.2) then
   let setup_name "&2"
else
   let setup_name "setup"
endif
!
if (pro%narg.lt.1) then
   @ setup-inter 'setup_name'
   @ setup-sd 'setup_name'
else if (pro%arg[1].eq."inter") then
   @ setup-inter 'setup_name'
else if (pro%arg[1].eq."sd") then
   @ setup-sd 'setup_name'
else if (pro%arg[1].eq."both") then
   @ setup-inter 'setup_name'
   @ setup-sd 'setup_name' needed
else
   message e setup "Unknown option: &1"
endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
