!
subroutine getfits(filename,tmpbackend,stepcompress,   &
     cryoextension,derotextension,trackingcutoff,   &
     currentindex,firstifb,ncf,nfb,subscanRange,nosky,error)
!
! Reads the imbfits file (version < 2.0) into MIRA's data structures (define in
! mira_use.f90). Called by subroutine getmira. See "MIRA\help get" for possible options.
!
   !
   use mira
   use gbl_constant
   use cfitsio_status
   use telcal_interfaces
   use fit_definitions
   use pcross_definitions
   use focus_definitions
   !
   implicit none
   !
   integer            :: firstifb, ncf, nfb
   character(len=200) :: filename
   logical            :: error, keep
   integer            :: blocksize, currentindex, hdutype, i,           &
                         ibd, icol, idcol, idump, idump1, idump2,       &
                         idump3, idump4, ier, ifb, iobs, istart,        &
                         iend, j, jfb, j1, j2, k, l, lastifb,           &
                         mxchan, nbd, nchan, nxchan, ndump,             &
                         ndumpantenna, ndumpantennanew,                 &
                         ndumpantennafast, ndumpantennafastnew,         &
                         ndumpcryo, ndumpderot, nhdu, noffset, nrecords,&
                         nrecnew, ndumpfrontend, ndumpsubref, nphases,  &
                         npix, readwrite=0, status=0, tracerate, unit
   integer            :: idcol_mjd, idcol_integtim, idcol_iswitch,      &
                         idcol_data
   integer, dimension(2) :: subscanRange
   !
   real               :: nullval
   real*4             :: aux, median
   real*8             :: dumptime,stepcompress,trackingcutoff
   !
   !
   character(len=1)   :: nullstr
   character(len=6)   :: subscanstring, string
   character(len=8)   :: keystring, offsetstring
   character(len=8)   :: backend, focustranslationdirection, specsys
   character(len=20)  :: backendextension, tmpformat, dataformat,   &
                         frontend, swtchmod
   character(len=23)  :: tmpbackend
   character(len=20)  :: tmpscantype, tmpswitchmode
   character(len=23)  :: subscantime
   character(len=80)  :: comment
   logical            :: anynull, readonly
   !
   !
   integer, dimension(:), allocatable         :: intdata
   real, dimension(:), allocatable            :: realdata
   real*8, dimension(:), allocatable          :: doubledata
   integer, dimension(:), allocatable         :: subscantrace,   &
                                                 traceflag,   &
                                                 tmptraceflag
   real*8                                     :: fmax,fmin,   &
                                                 focusoffset,f1,f2,   &
                                                 substime,velosys,   &
                                                 posanghera
   logical, dimension(1)                      :: flagscalar
   logical, dimension(:), allocatable         :: flagvals,   &
                                                 traceflagdefined
   !
   type myslowdap
      integer :: subscan
      integer :: traceflag
      real*8  :: mjd
      real*8  :: lst
      real*8  :: longoff
      real*8  :: latoff
      real*8  :: baslong
      real*8  :: baslat
      real*8  :: parangle
   end type myslowdap
   !
   type myfastdap
      integer :: subscanfast
      real*8, dimension(3) :: encoder_az_el
      real*8, dimension(2) :: tracking_az_el
   end type myfastdap
   !
   type(myslowdap), dimension(:), allocatable :: slowdap
   type(myfastdap), dimension(:), allocatable :: fastdap
   !
   type(arraydata_data)                                      :: artmp
   !
   integer                                      :: allchannels,   &
                                                   nrowbackendtable
   integer                                      :: ipix,ichan,iph,   &
                                                   irow, i1, i2, i3,   &
                                                   i4, i5, i6, m,   &
                                                   nbin, ncfe,pswitch
   integer                                      :: idxantenna,   &
                                                   idxstart,   &
                                                   idxsubref,   &
                                                   idxcryo,   &
                                                   idxderot,   &
                                                   idxbackend, next
   integer, dimension(:), allocatable           :: refchan, chans,   &
                                                   dropped, used,   &
                                                   band, baseband,   &
                                                   pixel, tmpsubscan
   logical                                      :: cryoextension,   &
                                                   derotextension,   &
                                                   nosky
   logical, dimension(:), allocatable           :: bandmask,   &
                                                   compressmask,   &
                                                   foundfebe
   integer, dimension(:,:), allocatable         :: iddump
   real                                         :: imbftsve
   real*8                                       :: pmjd, pintegtim
   real, dimension(:), allocatable              :: reffreq, spacing
   character(len=12), dimension(:), allocatable :: rec1, rec2
   character(len=20), dimension(:), allocatable :: sysoff
   !
   integer                                      :: bandsave, k1, k2
   integer                                      :: nrowfrontendtable
   integer, dimension(:), allocatable           :: indx, nfeeds,   &
                                                   part, irank
   real, dimension(:), allocatable              :: beameff,etafss,   &
                                                   gainimag,tcold,   &
                                                   ifcenter,   &
                                                   frqoff1,frqoff2,   &
                                                   frqthrow
   real*8, dimension(:), allocatable            :: fx,restfreq,   &
                                                   sbsep,tcoldmon,   &
                                                   tmpfocus
   real*8                                       :: pcoldimage,   &
                                                   pcoldsignal,   &
                                                   photimage,   &
                                                   photsignal,   &
                                                   pcoldimagenew,   &
                                                   pcoldsignalnew,   &
                                                   photimagenew,   &
                                                   photsignalnew
   real*8                                       :: tmpcalib
   real*8                                       :: trec, gainimage,   &
                                                   pcoldimagemean,   &
                                                   photimagemean
   character(len=3), dimension(:), allocatable  :: sideband
   character(len=6), dimension(:), allocatable  :: widenar
   character(len=20)                            :: tmpfrontend
   character(len=20), dimension(:), allocatable :: recname, linename
   character(len=32)                            :: message
   !
   ! local variables related to polarimetry
   !
   integer                                              :: nspec
   integer, dimension(:), allocatable                   :: ifbold
   real*8                                               :: ccimag
   real*8                                               :: ccreal
   character(len=1), dimension(4), parameter            :: stokes =   &
                                                           (/'H','V','R','I'/)
   character(len=4), dimension(:), allocatable          :: polar
   character(len=10), dimension(:),allocatable          :: poltype
   character(len=12), dimension(:), allocatable         :: rec3
   logical                                              :: polmode
   logical, dimension(:,:), allocatable                 :: mask
   logical, dimension(:), allocatable                   :: calmask
   type(flag), dimension(:), allocatable                :: reducetmp
   type(febepar), dimension(:), pointer                 :: febetmp   &
                                                           => null()
   type(arraydata), dimension(:), pointer               :: arraytmp   &
                                                           => null()
   type(datapar), dimension(:), pointer                 :: datatmp   &
                                                           => null()
   type(monitor), dimension(:), pointer                 :: montmp   &
                                                           => null()
   type(calibration), dimension(:), pointer             :: gainstmp   &
                                                           => null()
   type(imbfitsantenna), dimension(:), allocatable      :: antennatmp
   type(imbfitsbackend), dimension(:), allocatable      :: backendtmp
   type(imbfitssubreflector), dimension(:), allocatable :: subreftmp
   !
   !
   error = .false.
   !
   if (firstifb.eq.1) then
      !
      if (associated(scan)) call freescan(scan%data,error)
      if (associated(sc%data%longoff)) call freescan(sc%data,error)
      !
      if (allocated(fb)) then
         do ifb = 1, size(fb)
            call freefebe(fb(ifb)%data,error)
         enddo
         deallocate(fb, stat = ier)
      endif
      !
      if (allocated(databuf)) then
         do ifb = 1, size(databuf)
            call freedata(databuf(ifb)%data,error)
         enddo
         deallocate(databuf,stat=ier)
      endif
      !
      if (allocated(arraybuf)) then
         do ifb = 1, size(array)
            do ibd = 1, size(arraybuf(ifb)%header)
               call freearray(arraybuf(ifb)%data(ibd),error)
            enddo
            deallocate(arraybuf(ifb)%header,   &
              arraybuf(ifb)%data,stat =ier)
         enddo
         deallocate(arraybuf,stat=ier)
      endif
      !
      if (allocated(monbuf)) then
         do ifb = 1, size(monbuf)
            call freemon(monbuf(ifb)%data,error)
         enddo
         deallocate(monbuf,stat=ier)
      endif
      !
      if (allocated(reduce)) deallocate(reduce,stat = ier)
      if (associated(cryo))    call freecryo(cryo,error)
      if (associated(crx%mjd)) call freecryo(crx, error)
      if (associated(derot))   call freederot(derot,error)
      if (associated(drt%mjd)) call freederot(drt,error)
      !
      if (allocated(raw)) then
         do i = 1, size(raw)
            call freeraw(raw(i), error)
         enddo
         deallocate(raw, stat = ier)
      endif
      !
      if (allocated(antdata%encoder_az_el))   &
        deallocate(antdata%encoder_az_el,stat=ier)
      if (allocated(antdata%tracking_az_el))   &
        deallocate(antdata%tracking_az_el,stat=ier)
      if (allocated(antdata%slowtrace))   &
        deallocate(antdata%slowtrace,stat=ier)
   !
   endif
   !
   call ftgiou(unit,status)
   call ftopen(unit,filename,readwrite,blocksize,status)
   !
   if (status.ne.0) then
      call gagout('E-GET: Open fits file error.')
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   !
   !
   call ftmahd(unit,1,hdutype,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   call ftgkys(unit,'IMBFTSVE',pr%header%mbftsver,comment,status)
   read(pr%header%mbftsver,'(f3.1)') imbftsve
   if (imbftsve.ge.2.0) then
      call ftclos(unit,status)
      call ftfiou(-1,status)
!      call gagout('E-GET: wrong IMBFITS format.')
      status = 0
      error = .true.
      return
   endif
   call ftgkyj(unit,'NAXIS   ',pr%header%naxis,comment,status)
   call ftgkyl(unit,'SIMPLE  ',pr%header%simple,comment,status)
   call ftgkyj(unit,'BITPIX  ',pr%header%bitpix,comment,status)
   call ftgkyl(unit,'EXTEND  ',pr%header%extend,comment,status)
   call ftgkys(unit,'TELESCOP',pr%header%telescop,comment,status)
   sc%header%telescop = pr%header%telescop
   call ftgkys(unit,'ORIGIN  ',pr%header%origin,comment,status)
   call ftgkys(unit,'CREATOR ',pr%header%creator,comment,status)
   call ftgkys(unit,'DATE-OBS',sc%header%date_obs,comment,status)
   call ftgkyj(unit,'N_OBSP  ',sc%header%nobs,comment,status)
   !
   if (imbftsve.ge.1.2) then
      idxstart = 4
   else
      idxstart = 3
   endif
   !
   hdutype = 2
   call ftmnhd(unit,hdutype,'IMBF-scan',0,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   !
   call ftgkyd(unit,'SITELONG',sc%header%sitelong,comment,status)
   call ftgkyd(unit,'SITELAT ',sc%header%sitelat,comment,status)
   call ftgkye(unit,'SITEELEV',sc%header%siteelev,comment,status)
   call ftgkys(unit,'OBSID   ',sc%header%obsid,comment,status)
   call ftgkys(unit,'PROJID  ',sc%header%projid,comment,status)
   call ftgkyj(unit,'SCANNUM ',sc%header%scannum,comment,status)
   call ftgkys(unit,'OBJECT  ',sc%header%object,comment,status)
   call ftgkyd(unit,'MJD     ',sc%header%mjd,comment,status)
   call ftgkyd(unit,'LST     ',sc%header%lst,comment,status)
!  call ftgkyj(unit,'N_OBS   ',sc%header%nobs,comment,status)
!  commented out by H.W.
   call ftgkyj(unit,'NFEBE   ',sc%header%nfebe,comment,status)
   sc%header%nfebe = ncf
   sc%header%taiutc = 32d0     ! will change in future due to leap seconds
   call ftgkyd(unit,'ETUTC   ',sc%header%etutc,comment,status)
   ! sc%header%scanlen, sc%header%scanskew still to be checked in
   sc%header%scanline = sc%header%nobs
   !
   if (subscanRange(1).eq.0.and.subscanRange(2).eq.0) then
     nsubscan = sc%header%nobs
     subscanRange(1) = 1
     subscanRange(2) = nsubscan
   else if (subscanRange(2).lt.subscanRange(1).or. &
 &          subscanRange(1).le.0.or.subscanRange(2).le.0.or. &
 &          subscanRange(2).gt.sc%header%nobs) then
     call gagout('W-GET: invalid subscan range. Reading all subscans.')
     nsubscan = sc%header%nobs
     subscanRange(1) = 1
     subscanRange(2) = nsubscan
   else
     nsubscan = subscanRange(2)-subscanRange(1)+1
   endif
   !
   call ftthdu(unit,nhdu,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   if ((nhdu-idxstart)/nsubscan.lt.3) then
      call gagout('E-GET: input file ')
      call gagout('       '//trim(filename))
      call gagout('       is incomplete.')
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   !
   !
   if (firstifb.eq.1) then
      allocate(raw(nsubscan),stat=ier)
      do i = 1, nsubscan
         allocate(   &
           raw(i)%antenna(nfb),   &
           raw(i)%backend(nfb),   &
           raw(i)%subref(nfb),   &
           stat=ier)
      enddo
   endif
   !
   call ftgkys(unit,'CTYPE1  ',sc%header%ctype1,comment,status)
   call ftgkys(unit,'CTYPE2  ',sc%header%ctype2,comment,status)
   call ftgkys(unit,'RADESYS ',sc%header%radecsys,comment,status)
   call ftgkye(unit,'EQUINOX ',sc%header%equinox,comment,status)
!! nochmals
!!   sc%header%ctype1 = 'RA-SFL'
!!   sc%header%ctype2 = 'DEC-SFL'
   call ftgkyd(unit,'CRVAL1  ',sc%header%crval1,comment,status)
   call ftgkyd(unit,'CRVAL2  ',sc%header%crval2,comment,status)
   call ftgkyd(unit,'LONPOLE ',sc%header%lonpole,comment,status)
   call ftgkyd(unit,'LATPOLE ',sc%header%latpole,comment,status)
   call ftgkyd(unit,'LONGOBJ ',sc%header%longobj,comment,status)
   call ftgkyd(unit,'LATOBJ  ',sc%header%latobj,comment,status)
   !
   noffset = 0
   status = 0
   if (imbftsve.ge.1.2) then
      call ftgkyj(unit,'NOSWITCH',nphases,comment,status)
      call ftgkys(unit,'SWTCHMOD',swtchmod,comment,status)
      call ftgkyj(unit,'NAXIS2',noffset,comment,status)
      if (noffset.ne.0) then
         if (allocated(flagvals)) deallocate(flagvals)
         allocate(flagvals(noffset),stat=ier)
         allocate(sc%data%longoff(noffset),stat=ier)
         allocate(sc%data%latoff(noffset),stat=ier)
         allocate(sysoff(noffset),stat=ier)
         call ftgcno(unit,.false.,'SYSOFF',idcol,status)
         call ftgcvs(unit,idcol,1,1,noffset,nullstr,sysoff,anynull,   &
           status)
         call ftgcno(unit,.false.,'XOFFSET',idcol,status)
         call ftgcfd(unit,idcol,1,1,noffset,sc%data%longoff,flagvals,   &
           anynull,status)
         call ftgcno(unit,.false.,'YOFFSET',idcol,status)
         call ftgcfd(unit,idcol,1,1,noffset,sc%data%latoff,flagvals,   &
           anynull,status)
         sc%data%longoff = sc%data%longoff*rad2deg
         sc%data%latoff = sc%data%latoff*rad2deg
         deallocate(flagvals)
      endif
   else
      do i = 1, nmxoff
         write(offsetstring,'(A7,I1)') 'XOFFSET', i
         call ftgkey(unit,trim(offsetstring),keystring,comment,   &
           status)
         if (len_trim(keystring).ne.1.and.status.eq.0) then
            noffset = noffset+1
         else
            status = 0
         endif
      enddo
      if (noffset.ne.0) then
         allocate(sc%data%longoff(noffset),stat=ier)
         allocate(sc%data%latoff(noffset),stat=ier)
         allocate(sysoff(noffset),stat=ier)
         do i = 1, noffset
            write(offsetstring,'(A7,I1)') 'XOFFSET', i
            call ftgkyd(unit,trim(offsetstring),sc%data%longoff(i),   &
              comment,status)
            offsetstring(1:1) = 'Y'
            call ftgkyd(unit,trim(offsetstring),sc%data%latoff(i),   &
              comment,status)
            write(offsetstring,'(A6,I1)') 'SYSOFF', i
            call ftgkys(unit,trim(offsetstring),sysoff(i),comment,   &
              status)
            call sic_upper(sysoff(i))
         enddo
         sc%data%longoff = sc%data%longoff*rad2deg
         sc%data%latoff = sc%data%latoff*rad2deg
      endif
   endif
   status = 0
   !
   !      call ftgkyl(unit,'MOVEFRAM',sc%header%movefram,comment,status)
   !      call ftgkyl(unit,'WOBUSED ',sc%header%wobused,comment,status)
   call ftgkyd(unit,'WOBTHROW',sc%header%wobthrow,comment,status)
   call ftgkye(unit,'WOBCYCLE',sc%header%wobcycle,comment,status)
   call ftgkys(unit,'WOBDIR  ',sc%header%wobdir,comment,status)
   call ftgkye(unit,'P1      ',sc%header%ia,comment,status)
   call ftgkye(unit,'P2      ',sc%header%ca,comment,status)
   call ftgkye(unit,'P7      ',sc%header%ie,comment,status)
   if (firstifb.eq.1) then
      allocate(mnt(nfb),stat=ier)
   endif
   call ftgkyd(unit,'P1COR   ',   &
     mnt(firstifb)%header%iaobs_caobs_ieobs(1),comment,status)
   call ftgkyd(unit,'P2COR   ',   &
     mnt(firstifb)%header%iaobs_caobs_ieobs(2),comment,status)
   call ftgkyd(unit,'P7COR   ',   &
     mnt(firstifb)%header%iaobs_caobs_ieobs(3),comment,status)
   mnt(firstifb)%header%iaobs_caobs_ieobs(1:3)   &
     = mnt(firstifb)%header%iaobs_caobs_ieobs(1:3)*rad2deg
   call ftgkyd(unit,'FOCUSX  ',mnt(firstifb)%header%focobs_x_y_z(1),   &
     comment,status)
   call ftgkyd(unit,'FOCUSY  ',mnt(firstifb)%header%focobs_x_y_z(2),   &
     comment,status)
   call ftgkyd(unit,'FOCUSZ  ',mnt(firstifb)%header%focobs_x_y_z(3),   &
     comment,status)
   !
   ! need here sc%header%ia, sc%header%ca, sc%header%npae, sc%header%aw,
   ! sc%header%an, sc%header%ie, sc%header%ecec, sc%header%zflx,
   ! sc%header%scandir
   !
   !
   if (firstifb.eq.1) then
      allocate(sc%data%febe(nfb),stat=ier)
      allocate(fb(nfb),stat=ier)
      allocate(ar(nfb),stat=ier)
      allocate(dt(nfb),stat=ier)
      allocate(reduce(nfb),stat=ier)
   endif
   !
   lastifb = firstifb+sc%header%nfebe-1
   if (lastifb.eq.nfb) sc%header%nfebe = nfb
   !
   if (imbftsve.ge.1.2) then
      call ftmnhd(unit,hdutype,'IMBF-backend',0,status)
   else
      call ftmnhd(unit,hdutype,'IMBF-scan',0,status)
   endif
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   call ftgkyj(unit,'NAXIS2',nrowbackendtable,comment,status)
   if (nrowbackendtable.eq.0.and.tmpbackend.ne."ABBA") then
      call gagout('E-GET: imbFits scan table is empty.')
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   else if (tmpbackend.eq."ABBA") then
      goto 11
   endif
   allocate(   &
     refchan(nrowbackendtable),chans(nrowbackendtable),   &
     dropped(nrowbackendtable),used(nrowbackendtable),   &
     band(nrowbackendtable),baseband(nrowbackendtable),   &
     pixel(nrowbackendtable),   &
     rec1(nrowbackendtable),rec2(nrowbackendtable),   &
     rec3(nrowbackendtable),   &
     polar(nrowbackendtable),reffreq(nrowbackendtable),   &
     spacing(nrowbackendtable),bandmask(nrowbackendtable),   &
     stat=ier   &
     )
   do i = 1, nrowbackendtable
      rec1(i) = '            '
      rec2(i) = '            '
      rec3(i) = '            '
   enddo
   call ftgcno(unit,.false.,'REFCHAN',idcol,status)
   if (allocated(flagvals)) deallocate(flagvals)
   allocate(flagvals(nrowbackendtable),stat=ier)
   call ftgcfj(unit,idcol,1,1,nrowbackendtable,refchan,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'CHANS',idcol,status)
   call ftgcfj(unit,idcol,1,1,nrowbackendtable,chans,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'DROPPED',idcol,status)
   call ftgcfj(unit,idcol,1,1,nrowbackendtable,dropped,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'USED',idcol,status)
   call ftgcfj(unit,idcol,1,1,nrowbackendtable,used,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'BAND',idcol,status)
   call ftgcfj(unit,idcol,1,1,nrowbackendtable,band,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'PIXEL',idcol,status)
   call ftgcfj(unit,idcol,1,1,nrowbackendtable,pixel,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'REC1',idcol,status)
   call ftgcvs(unit,idcol,1,1,nrowbackendtable,nullstr,rec1,anynull,   &
     status)
   call ftgcno(unit,.false.,'REC2',idcol,status)
   call ftgcvs(unit,idcol,1,1,nrowbackendtable,nullstr,rec2,anynull,   &
     status)
   polmode = count(rec1.ne.rec2).ne.0   &
     .and.index(tmpbackend,'VESPA').ne.0
   if (polmode) then
      do i = 1, nrowbackendtable
         if (index(rec1(i),'A').ne.0.and.index(rec2(i),'B').ne.0)   &
           then
            rec3(i) = rec1(i)//rec2(i)
         else if (index(rec2(i),'A').ne.0.and.index(rec1(i),'B')   &
           .ne.0) then
            rec3(i) = rec2(i)//rec1(i)
         else if (index(rec1(i),'C').ne.0.and.index(rec2(i),'D')   &
           .ne.0) then
            rec3(i) = rec1(i)//rec2(i)
         else if (index(rec2(i),'C').ne.0.and.index(rec1(i),'D')   &
           .ne.0) then
            rec3(i) = rec2(i)//rec1(i)
         else if (rec1(i).eq.rec2(i)) then
            rec3(i) = rec1(i)//rec2(i)
         endif
      enddo
   endif
   call ftgcno(unit,.false.,'POLAR',idcol,status)
   call ftgcvs(unit,idcol,1,1,nrowbackendtable,nullstr,polar,anynull,   &
     status)
   call ftgcno(unit,.false.,'REFFREQ',idcol,status)
   call ftgcfe(unit,idcol,1,1,nrowbackendtable,reffreq,flagvals,   &
     anynull,status)
   call ftgcno(unit,.false.,'SPACING',idcol,status)
   call ftgcfe(unit,idcol,1,1,nrowbackendtable,spacing,flagvals,   &
     anynull,status)
   !
   if (polmode) then
      do i = 2, nrowbackendtable
         do k = 1, i-1
            if (band(i).eq.band(k).and.(rec3(i).ne.rec3(k).or.   &
              polar(i).ne.polar(k))) then
               bandsave = band(i)
               band(i) = maxval(band)+1
               do j = i+1, nrowbackendtable
                  if (rec3(j).eq.rec3(i).and.polar(j).eq.polar(i)   &
                    .and.band(j).eq.bandsave)   &
                    band(j) = band(i)
               enddo
            endif
         enddo
      enddo
   else
      do i = 2, nrowbackendtable
         do k = 1, i-1
            if (band(i).eq.band(k).and.rec1(i).ne.rec1(k)) then
               bandsave = band(i)
               band(i) = maxval(band)+1
               do j = i+1, nrowbackendtable
                  if (rec1(j).eq.rec1(i).and.band(j).eq.bandsave)   &
                    band(j) = band(i)
               enddo
            endif
         enddo
      enddo
   endif
   !
   ncfe = maxval(band)
   k1 = ncfe
   do k = 1, ncfe
      if (count(band.eq.k).eq.0) k1 = k1-1
   enddo
   do k = 1, ncfe
      if (count(band.eq.k).eq.0) then
         do j = 1, nrowbackendtable
            if (band(j).gt.k) band(j) = band(j)-1
         enddo
      endif
   enddo
   ncfe = k1
   !
   k1 = minval(band)
   if (k1.ne.1) then
      do k = 1, nrowbackendtable
         band(k) = band(k)-k1+1
      enddo
   endif
   !
   allocate(part(ncfe),indx(ncfe),irank(ncfe),stat=ier)
   !
   do i = 1, ncfe
      backend = list(currentindex)%backend(i)
      k1 = index(backend,'/')+1
      if (k1.ne.1) then
         k2 = len_trim(backend)
         read(backend(k1:k2),'(i3)') part(i)
      else
         part(i) = i
      endif
   enddo
   call indexx(ncfe,dble(part),indx)
   call rank(ncfe,indx,irank)
   !
   where (pixel(1:nrowbackendtable).eq.0)   &
     pixel(1:nrowbackendtable) = 1
   do i = 1, ncfe
      bandmask = band(1:nrowbackendtable).eq.i.and.   &
        pixel(1:nrowbackendtable).eq.1
      ifb = firstifb+irank(i)-1
      fb(ifb)%header%febeband = count(bandmask)
      do l = 1, maxval(pixel)
         k = 0
         do j = 1, nrowbackendtable
            if (band(j).eq.i.and.pixel(j).eq.l) then
               k = k+1
               baseband(j) = k
            endif
         enddo
      enddo
   enddo
   !
11 continue
   if (tmpbackend.eq."ABBA") then
      ncfe = 1
      allocate(   &
        refchan(1),chans(1),   &
        dropped(1),used(1),   &
        band(1),baseband(1),   &
        pixel(1),   &
        rec1(1),rec2(1),   &
        rec3(1),   &
        polar(1),reffreq(1),   &
        spacing(1),bandmask(1),stat=ier   &
        )
   endif
   !
   hdutype = 2
   nullstr = ' '
   call ftmnhd(unit,hdutype,'IMBF-frontend',0,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   call ftgkyj(unit,'SCANNUM ',fb(firstifb)%header%scannum,comment,   &
     status)
   if (imbftsve.lt.1.2) then
      call ftgkyj(unit,'NOSWITCH',fb(firstifb)%header%nphases,   &
        comment,status)
      call ftgkys(unit,'SWTCHMOD',fb(firstifb)%header%swtchmod,   &
        comment,status)
   else
      fb(firstifb)%header%nphases = nphases
      fb(firstifb)%header%swtchmod = swtchmod
   endif
   call ftgkys(unit,'DATE-OBS',fb(firstifb)%header%date_obs,comment,   &
     status)
   call ftgkys(unit,'DEWRTMOD',fb(firstifb)%header%dewrtmod,comment,   &
     status)
   call ftgkye(unit,'DEWANG  ',fb(firstifb)%header%dewang,comment,   &
     status)
   call ftgkys(unit,'VELOCONV',fb(firstifb)%header%veloconv,comment,   &
     status)
   if (status.ne.0) then
      fb(firstifb)%header%veloconv = 'optical'
      status = 0
   endif
   fb(firstifb+1:lastifb)%header%scannum   &
     = fb(firstifb)%header%scannum
   fb(firstifb+1:lastifb)%header%nphases   &
     = fb(firstifb)%header%nphases
   fb(firstifb+1:lastifb)%header%date_obs   &
     = fb(firstifb)%header%date_obs
   fb(firstifb+1:lastifb)%header%swtchmod   &
     = fb(firstifb)%header%swtchmod
   call sic_upper(fb(firstifb)%header%veloconv)
   fb(firstifb+1:lastifb)%header%veloconv   &
     = fb(firstifb)%header%veloconv
   call sic_upper(fb(firstifb)%header%dewrtmod)
   if (index(fb(firstifb)%header%dewrtmod,'C').eq.1.or.   &
       index(fb(firstifb)%header%dewrtmod,'F').eq.1) then
      fb(firstifb)%header%dewrtmod = 'CABIN'
   else if (index(fb(firstifb)%header%dewrtmod,'S').eq.1) then
      fb(firstifb)%header%dewrtmod = 'EQUA'
   else if (index(fb(firstifb)%header%dewrtmod,'H').eq.1) then
      fb(firstifb)%header%dewrtmod = 'HORIZ'
   else
      fb(firstifb)%header%dewrtmod = 'UNDEF'
   endif
   fb(firstifb+1:lastifb)%header%dewrtmod   &
     = fb(firstifb)%header%dewrtmod
   fb(firstifb+1:lastifb)%header%dewang   &
     = fb(firstifb)%header%dewang
   !
   if (index(sc%header%telescop,'30m').ne.0) then
      fb(firstifb:lastifb)%header%dewcabin = 'NASMYTH_A'
   else
      fb(firstifb:lastifb)%header%dewcabin = 'UNDEFINED'
   endif
   !
   call ftgkyj(unit,'NAXIS2',nrowfrontendtable,comment,status)
   allocate(nfeeds(nrowfrontendtable),sideband(nrowfrontendtable),   &
     beameff(nrowfrontendtable), etafss(nrowfrontendtable),   &
     gainimag(nrowfrontendtable), tcold(nrowfrontendtable),   &
     restfreq(nrowfrontendtable),sbsep(nrowfrontendtable),   &
     widenar(nrowfrontendtable),recname(nrowfrontendtable),   &
     linename(nrowfrontendtable),poltype(nrowfrontendtable),   &
     ifcenter(nrowfrontendtable),frqoff1(nrowfrontendtable),   &
     frqoff2(nrowfrontendtable),frqthrow(nrowfrontendtable),   &
     stat=ier)
   !
   if (tmpbackend.ne."ABBA") then
      call ftgkyd(unit,'VELOSYS',velosys,comment,status)
      call ftgkys(unit,'SPECSYS',specsys,comment,status)
      call ftgcno(unit,.false.,'LINENAME',idcol,status)
      call ftgcvs(unit,idcol,1,1,nrowfrontendtable,nullstr,linename,   &
        anynull, status)
      call ftgcno(unit,.false.,'BEAMEFF',idcol,status)
      call ftgcve(unit,idcol,1,1,nrowfrontendtable,nullval,beameff,   &
        anynull,status)
      call ftgcno(unit,.false.,'ETAFSS',idcol,status)
      call ftgcve(unit,idcol,1,1,nrowfrontendtable,nullval,etafss,   &
        anynull,status)
      call ftgcno(unit,.false.,'GAINIMAG',idcol,status)
      call ftgcve(unit,idcol,1,1,nrowfrontendtable,nullval,gainimag,   &
        anynull,status)
      call ftgcno(unit,.false.,'SIDEBAND',idcol,status)
      call ftgcvs(unit,idcol,1,1,nrowfrontendtable,nullstr,   &
        sideband,anynull,status)
      call ftgcno(unit,.false.,'SBSEP',idcol,status)
      call ftgcvd(unit,idcol,1,1,nrowfrontendtable,nullval,sbsep,   &
        anynull,status)
      call ftgcno(unit,.false.,'WIDENAR',idcol,status)
      call ftgcvs(unit,idcol,1,1,nrowfrontendtable,nullstr,widenar,   &
        anynull,status)
      call ftgcno(unit,.false.,'TCOLD',idcol,status)
      call ftgcve(unit,idcol,1,1,nrowfrontendtable,nullval,tcold,   &
        anynull,status)
      call ftgcno(unit,.false.,'NOFEEDS',idcol,status)
      call ftgcvj(unit,idcol,1,1,nrowfrontendtable,nullval,nfeeds,   &
        anynull,status)
      call ftgcno(unit,.false.,'POLA',idcol,status)
      call ftgcvs(unit,idcol,1,1,nrowfrontendtable,nullstr,poltype,   &
        anynull,status)
      call ftgcno(unit,.false.,'IFCENTER',idcol,status)
      call ftgcve(unit,idcol,1,1,nrowfrontendtable,nullval,ifcenter,   &
        anynull,status)
      call ftgcno(unit,.false.,'FRQTHROW',idcol,status)
      if (idcol.ne.0) call ftgcve(unit,idcol,1,1,nrowfrontendtable,   &
        nullval,frqthrow,anynull,status)
      call ftgcno(unit,.false.,'FRQOFF1',idcol,status)
      if (idcol.ne.0) call ftgcve(unit,idcol,1,1,nrowfrontendtable,   &
        nullval,frqoff1,anynull,status)
      call ftgcno(unit,.false.,'FRQOFF2',idcol,status)
      if (idcol.ne.0) call ftgcve(unit,idcol,1,1,nrowfrontendtable,   &
        nullval,frqoff2,anynull,status)
      call ftgcno(unit,.false.,'RECNAME',idcol,status)
      call ftgcvs(unit,idcol,1,1,nrowfrontendtable,nullstr,recname,   &
        anynull, status)
   else
      call ftgcno(unit,.false.,'RECNAME',idcol,status)
      if (idcol.ne.0) call ftgcvs(unit,idcol,1,1,nrowfrontendtable,   &
        nullstr,rec1,anynull,status)
      call ftgkyj(unit,'NUSEFEED',nfeeds,comment,status)
      chans(1) = 1
      spacing(1) = 0.
      used(1) = 1
      dropped(1) = 0
      recname(1) = rec1(1)
      frqoff1(1) = 0.
      frqoff2(1) = 0.
      beameff(1) = 1.0
      etafss(1) = 1.0
      fb(1)%header%febeband = 1
      linename(1) = ' '
   endif
   call ftgcno(unit,.false.,'RESTFREQ',idcol,status)
   call ftgcvd(unit,idcol,1,1,nrowfrontendtable,nullval,restfreq,   &
     anynull,status)
   !
   do ifb = firstifb, lastifb
      nbd = fb(ifb)%header%febeband
      allocate(ar(ifb)%header(nbd),ar(ifb)%data(nbd),stat=ier)
   enddo
   !
   if (allocated(foundfebe)) deallocate(foundfebe,stat=ier)
   allocate(foundfebe(nfb),stat=ier)
   foundfebe(1:nfb) = .false.
   !
   if (allocated(tcoldmon)) deallocate(tcoldmon,stat=ier)
   allocate(tcoldmon(nfb),stat=ier)
   !
   do i = 1, nrowbackendtable
      if (tmpbackend.ne."ABBA") then
         k = band(i)
         ifb = firstifb+irank(k)-1
      else
         band(1) = 1
         ifb = 1
         foundfebe(1) = .false.
         fb(ifb)%header%ifcenter = 0.
      endif
      if (foundfebe(ifb)) cycle
      nbd = fb(ifb)%header%febeband
      do j = 1, nrowfrontendtable
         if (index(recname(j),rec1(i)).ne.0) then
            !
            tmpfrontend = recname(j)
            if (polmode) then
               if (index(polar(i),'REAL').ne.0) then
                  tmpfrontend(1:1) = 'R'
               else if (index(polar(i),'IMAG').ne.0) then
                  tmpfrontend(1:1) = 'I'
               else if (index(polar(i),'AXIS').ne.0) then
                  if (index(rec1(i),'A').ne.0.or.   &
                      index(rec1(i),'C').ne.0) then
                     tmpfrontend(1:1) = 'V'
                  else if (index(rec1(i),'B').ne.0.or.   &
                           index(rec1(i),'D').ne.0) then
                     tmpfrontend(1:1) = 'H'
                  endif
               endif
            endif
            !
            npix = nfeeds(j)
            if (npix.le.0) npix = 1
            allocate(fb(ifb)%data%usefeed(npix),   &
                     fb(ifb)%data%feedtype(npix),   &
                     fb(ifb)%data%feedoffx(npix),   &
                     fb(ifb)%data%feedoffy(npix),   &
                     fb(ifb)%data%polty(npix),   &
                     fb(ifb)%data%pola(npix),   &
                     fb(ifb)%data%apereff(npix,nbd),   &
                     fb(ifb)%data%bolcalfc(npix),   &
                     fb(ifb)%data%flatfiel(npix,nbd),   &
                     fb(ifb)%data%gainimag(npix,nbd),   &
                     fb(ifb)%data%beameff(npix,nbd),   &
                     fb(ifb)%data%etafss(npix,nbd),   &
                     fb(ifb)%data%hpbw(npix,nbd),   &
                     fb(ifb)%data%antgain(npix,nbd),   &
                     fb(ifb)%data%gainele1(nbd),   &
                     fb(ifb)%data%gainele2(nbd),   &
              stat=ier)
            fb(ifb)%header%febefeed = npix
            fb(ifb)%header%nusefeed = npix
            fb(ifb)%header%ifcenter = ifcenter(j)*1.d9
            fb(ifb)%header%frqoff1 = frqoff1(j)*1.e9
            fb(ifb)%header%frqoff2 = frqoff2(j)*1.e9
            fb(ifb)%header%frqthrow = frqthrow(j)*1.e9
            if (index(poltype(j),'vertical').ne.0) then
               fb(ifb)%data%polty(1:npix) = 'Y'
            else if (index(poltype(j),'horizontal').ne.0) then
               fb(ifb)%data%polty(1:npix) = 'X'
            else
               fb(ifb)%data%polty(1:npix) = 'U'
            endif
            backend = list(currentindex)%backend(band(i))
            tmpbackend = backend
            call sic_upper(tmpbackend)
            sc%data%febe(ifb) = trim(tmpfrontend)//' '//trim(backend)
            fb(ifb)%header%febe = sc%data%febe(ifb)
            ar(ifb)%header(1:nbd)%febe = sc%data%febe(ifb)
            ar(ifb)%header(1:nbd)%transiti = linename(j)
            ar(ifb)%header(1:nbd)%molecule = linename(j)
            do ibd = 1, nbd
               ar(ifb)%header(ibd)%restfreq = restfreq(j)*1.d9
               ar(ifb)%header(ibd)%restfreqO = restfreq(j)*1.d9
               ar(ifb)%header(ibd)%sbsep = sbsep(j)
            enddo
            fb(ifb)%data%beameff(1,1) = beameff(j)
            fb(ifb)%data%beameff(1:npix,1:nbd)   &
              = fb(ifb)%data%beameff(1,1)
            fb(ifb)%data%etafss(1,1) = etafss(j)
            fb(ifb)%data%etafss(1:npix,1:nbd)   &
              = fb(ifb)%data%etafss(1,1)
            fb(ifb)%data%gainimag(1,1) = gainimag(j)
            fb(ifb)%data%gainimag(1:npix,1:nbd)   &
              = fb(ifb)%data%gainimag(1,1)
            ar(ifb)%header(1:nbd)%sideband = sideband(j)
            fb(ifb)%header%widenar = widenar(j)
            if (index(sc%header%telescop,'30m').ne.0) then
               fb(ifb)%data%hpbw(1:npix,1:nbd)   &
                 = 2460.d9/ar(ifb)%header(1)%restfreq/3600.
            else
               fb(ifb)%data%hpbw(1:npix,1:nbd) = -1000.
            endif
            fb(ifb)%data%antgain(1:npix,1:nbd) = 0. ! not yet done
            tcoldmon(ifb) = dble(tcold(j))
            !
            exit
         endif
      enddo
      foundfebe(ifb) = .true.
   enddo
   !
   !
   hdutype = 2
   call ftmnhd(unit,hdutype,'IMBF-antenna',0,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   call ftgkys(unit,'OBSTYPE ',sc%header%scantype,comment,status)
   call ftgkyd(unit,'SESPES01',sc%header%scanxvel,comment,status)
   sc%header%scanxvel = sc%header%scanxvel*rad2asec
   tmpscantype = sc%header%scantype
   call sic_upper(tmpscantype)
   !
   ! check completeness of subscans
   !
   if (index(tmpscantype,'FOCUS').ne.0.or.index(tmpscantype,'TIP').ne.0) then
      if (sc%header%nobs.lt.6) then
         call gagout('E-GET: '//tmpscantype//' needs at least 6 subscans.')
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
   endif
   !
   if (polmode.and.nsubscan.gt.3.and.index(tmpscantype,'CAL').ne.0)   &
     then
      sc%header%scantype = 'calibGrid'
      tmpscantype = 'CALIBGRID'
   endif
   tmpswitchmode = fb(1)%header%swtchmod
   call sic_upper(tmpswitchmode)
   if (index(tmpscantype,'CAL').ne.0.and.firstifb.eq.1) then
      if (allocated(gn)) then
         do ifb = 1, size(gn)
            call freegains(gn(ifb),error)
         enddo
         deallocate(gn)
      endif
      if (index(tmpswitchmode,'FREQ').ne.0) then
         allocate(gn(2*nfb),stat=ier)
      else
         allocate(gn(nfb),stat=ier)
      endif
   endif
   !
   !
   ndumpantenna = 0
   ndumpantennafast = 0
   ndumpantennanew = 0
   ndumpantennafastnew = 0
   !
   cryoextension = .false.
   derotextension = .false.
   call ftmnhd(unit,hdutype,'IMBF-hera-cryot',0,status)
   if (status.eq.0) then
      cryoextension = .true.
   else
      status = 0
   endif
   call ftmnhd(unit,hdutype,'IMBF-hera-derot',0,status)
   if (status.eq.0) then
      derotextension = .true.
   else
      status = 0
   endif
   !
   if (.not.cryoextension.and..not.derotextension) then
      next       = 3
      idxantenna = 1
      idxsubref  = 2
      idxbackend = 3
   else if (.not.derotextension) then
      next       = 4
      idxantenna = 1
      idxsubref  = 2
      idxcryo    = 3
      idxbackend = 4
   else
      next       = 5
      idxantenna = 1
      idxsubref  = 2
      idxcryo    = 3
      idxderot   = 4
      idxbackend = 5
   endif
   !
   if (allocated(subscantrace)) deallocate(subscantrace,stat=ier)
   allocate(subscantrace(nsubscan),stat=ier)
   !
   ndumpcryo = 0
   ndumpderot = 0
   subscanloop1: do i = subscanRange(1), subscanRange(2)
      j = idxstart+idxantenna+(i-1)*next
      i1 = i-subscanRange(1)+1 
      call ftmahd(unit,j,hdutype,status)
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      call ftgkyj(unit,'TRACERAT',tracerate,comment,status)
      call ftgkyj(unit,'NAXIS2',idump,comment,status)
      !
      if (allocated(traceflagdefined))   &
        deallocate(traceflagdefined,stat=ier)
      if (allocated(tmptraceflag))   &
        deallocate(tmptraceflag,stat=ier)
      if (allocated(flagvals)) deallocate(flagvals,stat=ier)
      allocate(flagvals(idump),traceflagdefined(idump),   &
        tmptraceflag(idump),stat=ier)
      !
      ndumpantenna = ndumpantenna+idump
      ndumpantennafast = ndumpantennafast+idump*tracerate
      call ftgkys(unit,'DATE-OBS',subscantime,comment,status)
      call dateobstomjd(subscantime,   &
                        raw(i1)%antenna(firstifb)%subscanstart,   &
                        status)
      call ftgkys(unit,'DATE-END',subscantime,comment,status)
      if (status.ne.0) then
         status = 0
         call ftgkyd(unit,'SUBSTIME',substime,comment,status)
         raw(i1)%antenna(firstifb)%subscanend   &
           = raw(i1)%antenna(firstifb)%subscanstart+substime*sec2day
      else
         call dateobstomjd(subscantime,   &
           raw(i1)%antenna(firstifb)%subscanend,status)
      endif
      call ftgkys(unit,'SYSTEMOF',raw(i1)%antenna(firstifb)%systemoff,   &
        comment,status)
      call ftgkyd(unit,'SUBSXOFF',   &
        raw(i1)%antenna(firstifb)%subscanxoff,comment,   &
        status)
      call ftgkyd(unit,'SUBSYOFF',   &
        raw(i1)%antenna(firstifb)%subscanyoff,comment,   &
        status)
      call ftgkyd(unit,'SEXSTA01',   &
        raw(i1)%antenna(firstifb)%segmentxstart,comment,   &
        status)
      call ftgkyd(unit,'SEYSTA01',   &
        raw(i1)%antenna(firstifb)%segmentystart,comment,   &
        status)
      call ftgkyd(unit,'SEXEND01',   &
        raw(i1)%antenna(firstifb)%segmentxend,comment,   &
        status)
      call ftgkyd(unit,'SEYEND01',   &
        raw(i1)%antenna(firstifb)%segmentyend,comment,   &
        status)
      call ftgkyd(unit,'DOPPLERC',   &
        raw(i1)%antenna(firstifb)%dopplercorr,comment,   &
        status)
      call ftgkyd(unit,'OBSVELRF',raw(i1)%antenna(firstifb)%obsvelrf,   &
        comment,status)
      if (status.ne.0.and.tmpbackend.ne."ABBA") then
         call gagout('W-GET: Doppler correction factor set to 1.')
         raw(i1)%antenna(firstifb)%dopplercorr = 1.0d0
         status = 0
      endif
      call ftgkys(unit,'SBCALREC',   &
        raw(i1)%antenna(firstifb)%sbcalrec,comment,   &
        status)
      if (status.ne.0) then
         raw(i1)%antenna(firstifb)%sbcalrec = 'UNKNOWN'
         status = 0
      else
         call sic_upper(raw(i1)%antenna(firstifb)%sbcalrec)
      endif
      raw(i1)%antenna(firstifb)%trackingerror = trackingcutoff
      raw(i1)%antenna(firstifb+1:lastifb) = raw(i1)%antenna(firstifb)
      call ftgcno(unit,.false.,'TRACEFLAG',idcol,status)
      call ftgcfj(unit,idcol,1,1,idump,tmptraceflag,flagvals,anynull,   &
        status)
      !
      if (idump.ne.0) then
         call medianinteger(tmptraceflag,idump,median)
         subscantrace(i) = int(median)
      else
         write(subscanstring,'(I3)') i
         call gagout('W-GET: subscan '//trim(subscanstring)//   &
                     ' contains no valid antenna data point.')
         subscantrace(i) = 2
      endif
      traceflagdefined = (tmptraceflag.ne.2.and.   &
                          subscantrace(i).eq.tmptraceflag)   &
                          .or.   &
                          index(tmpscantype,'CAL').ne.0
      if (count(traceflagdefined).eq.0) then
         write(subscanstring,'(I3)') i
         call gagout('W-GET: subscan '//trim(subscanstring)//   &
                     ' contains no valid antenna data point.')
      endif
      ndumpantennanew = ndumpantennanew+count(traceflagdefined)
      ndumpantennafastnew = ndumpantennafastnew   &
        +tracerate*count(traceflagdefined)
      !
      j = idxstart+idxsubref+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      !
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      !
      call ftgkys(unit,'DATE-OBS',subscantime,comment,status)
      call dateobstomjd(subscantime,   &
        raw(i1)%subref(firstifb)%subscanstart,status)
      call ftgkys(unit,'DATE-END',subscantime,comment,status)
      if (status.ne.0) then
         status = 0
         call ftgkyd(unit,'SUBSTIME',substime,comment,status)
         raw(i1)%subref(firstifb)%subscanend   &
           = raw(i1)%subref(firstifb)%subscanstart+substime*sec2day
      else
         call dateobstomjd(subscantime,   &
           raw(i1)%subref(firstifb)%subscanend,status)
      endif
      call ftgkyd(unit,'SEXSTA01',   &
        raw(i1)%subref(firstifb)%segmentxstart,comment,   &
        status)
      call ftgkyd(unit,'SEYSTA01',   &
        raw(i1)%subref(firstifb)%segmentystart,comment,   &
        status)
      call ftgkyd(unit,'SEXEND01',   &
        raw(i1)%subref(firstifb)%segmentxend,comment,status)
      call ftgkyd(unit,'SEYEND01',   &
        raw(i1)%subref(firstifb)%segmentyend,comment,status)
      !
      raw(i1)%subref(firstifb+1:lastifb) = raw(i1)%subref(firstifb)
      !
      if (cryoextension) then
         j = idxstart+idxcryo+(i-1)*next
         call ftmahd(unit,j,hdutype,status)
         call ftgkyj(unit,'NAXIS2',idump,comment,status)
         ndumpcryo = ndumpcryo+idump
      endif
      !
      if (derotextension) then
         j = idxstart+idxderot+(i-1)*next
         call ftmahd(unit,j,hdutype,status)
         call ftgkyj(unit,'NAXIS2',idump,comment,status)
         ndumpderot = ndumpderot+idump
      endif
      !
      j = idxstart+idxbackend+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      !
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      !
      call ftgkys(unit,'DATE-OBS',subscantime,comment,status)
      do ifb = firstifb, lastifb
         do ibd = 1, nbd
            ar(ifb)%header(1)%date_obs = subscantime
            ar(ifb)%header(1)%scannum = fb(firstifb)%header%scannum
         enddo
      enddo
      !
      call dateobstomjd(subscantime,   &
        raw(i1)%backend(firstifb)%subscanstart,status)
      call ftgkys(unit,'DATE-END',subscantime,comment,status)
      if (status.ne.0) then
         status = 0
         raw(i1)%backend(firstifb)%subscanend   &
           = raw(i1)%backend(firstifb)%subscanstart
      else
         call dateobstomjd(subscantime,   &
           raw(i1)%backend(firstifb)%subscanend,status)
      endif
      raw(i1)%backend(firstifb+1:lastifb) = raw(i1)%backend(firstifb)
   !
   enddo subscanloop1
   !
   if (.not.timingCheck) then
      ndumpAntennaNew     = ndumpAntenna
      ndumpAntennaFastNew = ndumpAntennaFast
   endif
   !
   if (cryoextension.and.ndumpcryo.ge.1) then
      ! In case of empty tables allocate at least 1 (otherwise ifort crash)
      allocate(crx%mjd(ndumpcryo), crx%cr4k1(ndumpcryo),   &
               crx%cr4k2(ndumpcryo),stat=ier)
   elseif (cryoextension.and.ndumpcryo.lt.1) then
      allocate(crx%mjd(1), crx%cr4k1(1),   &
               crx%cr4k2(1),stat=ier)
      print*,'No data in cryo table'
   endif
   !
   !
   if (derotextension.and.ndumpderot.ge.1) then
      ! In case of empty tables allocate at least 1 (otherwise ifort crash)
      allocate(drt%mjd(ndumpderot), drt%actframe(ndumpderot),   &
        stat=ier)
   elseif (derotextension.and.ndumpderot.lt.1) then
      allocate(drt%mjd(1), drt%actframe(1),   &
        stat=ier)
      print*,'No data in derot table'  
   endif
   !
   !
   ndumpfrontend = 1
   !
   !
   i2 = 0
   i4 = 0
   ndumpsubref = 0
   subscanloop2: do i = subscanRange(1), subscanRange(2)
      j = idxstart+idxsubref+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      !
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      !
      call ftgkyj(unit,'NAXIS2',idump,comment,status)
      ndumpsubref = ndumpsubref+idump
      !
      if (cryoextension) then
         j = idxstart+idxcryo+(i-1)*next
         call ftmahd(unit,j,hdutype,status)
         call ftgkyj(unit,'NAXIS2',idump,comment,status)
         if (allocated(flagvals)) deallocate(flagvals,stat=ier)
         allocate(flagvals(idump),stat=ier)
         i1 = i2+1
         i2 = i2+idump
         call ftgcno(unit,.false.,'MJD',idcol,status)
         call ftgcfd(unit,idcol,1,1,idump,crx%mjd(i1:i2),flagvals,   &
           anynull,status)
         call ftgcno(unit,.false.,'cr4K',idcol,status)
         call ftgcfe(unit,idcol,1,1,idump,crx%cr4k1(i1:i2),flagvals,   &
           anynull,status)
         call ftgcno(unit,.false.,'cr4K2',idcol,status)
         call ftgcfe(unit,idcol,1,1,idump,crx%cr4k2(i1:i2),flagvals,   &
           anynull,status)
      endif
      !
      if (derotextension) then
         j = idxstart+idxderot+(i-1)*next
         call ftmahd(unit,j,hdutype,status)
         call ftgkyj(unit,'NAXIS2',idump,comment,status)
         if (allocated(flagvals)) deallocate(flagvals,stat=ier)
         allocate(flagvals(idump),stat=ier)
         i3 = i4+1
         i4 = i4+idump
         call ftgcno(unit,.false.,'MJD',idcol,status)
         call ftgcfd(unit,idcol,1,1,idump,drt%mjd(i3:i4),flagvals,   &
           anynull,status)
         call ftgcno(unit,.false.,'fAct',idcol,status)
         call ftgcfe(unit,idcol,1,1,idump,drt%actframe(i3:i4),   &
           flagvals,anynull,status)
      endif
   !
   enddo subscanloop2
   !
   !
   if (firstifb.eq.1)   &
     allocate(antdata%encoder_az_el(ndumpantennafast,3),   &
              antdata%tracking_az_el(ndumpantennafast,2),  &
              antdata%slowtrace(ndumpantenna,3),           &
              stat=ier)
   do ifb = firstifb, lastifb
      allocate(mnt(ifb)%data%subscan(ndumpantennanew),   &
               mnt(ifb)%data%subscanfast(ndumpantennafastnew),   &
               mnt(ifb)%data%subscansubref(ndumpsubref),   &
               mnt(ifb)%data%mjd(ndumpantennanew),   &
               mnt(ifb)%data%lst(ndumpantennanew),   &
               mnt(ifb)%data%encoder_az_el(ndumpantennafastnew,3),   &
               mnt(ifb)%data%tracking_az_el(ndumpantennafastnew,2),   &
               mnt(ifb)%data%longoff(ndumpantennanew),   &
               mnt(ifb)%data%latoff(ndumpantennanew),   &
               mnt(ifb)%data%baslong(ndumpantennanew),   &
               mnt(ifb)%data%baslat(ndumpantennanew),   &
               mnt(ifb)%data%parangle(ndumpantennanew),   &
               mnt(ifb)%data%antenna_az_el(2),   &
               mnt(ifb)%data%tamb_p_humid(ndumpfrontend,3),   &
               mnt(ifb)%data%wind_dir_vavg_vmax(ndumpfrontend,3),   &
               mnt(ifb)%data%thotcold(ndumpfrontend,2),   &
               mnt(ifb)%data%refractio(ndumpfrontend),   &
               mnt(ifb)%data%focus_x_y_z(ndumpsubref,4),   &
               mnt(ifb)%data%dfocus_x_y_z(ndumpsubref,3),   &
               mnt(ifb)%data%dphi_x_y_z(ndumpsubref,3),   &
               mnt(ifb)%data%phi_x_y_z(ndumpsubref,3),   &
               stat = ier)
   enddo
   if (allocated(traceflag)) deallocate(traceflag,stat=ier)
   allocate(traceflag(ndumpantennanew),stat=ier)
   !
   hdutype = 2
   idump2 = 0
   subscanloop3: do i = subscanRange(1), subscanRange(2)
      i1 = i-subscanRange(1)+1
      j = idxstart+idxsubref+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      !
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      !
      call ftgkyj(unit,'NAXIS2',idump,comment,status)
      call ftgkys(unit,'SUBSTYPE',   &
        raw(i1)%subref(firstifb)%subscantype,comment,status)
      raw(i1)%subref(firstifb+1:lastifb) = raw(i1)%subref(firstifb)
      idump1 = idump2+1
      idump2 = idump2+idump
      if (allocated(flagvals)) deallocate(flagvals)
      allocate(flagvals(idump),stat=ier)
      if (allocated(tmpfocus)) deallocate(tmpfocus)
      allocate(tmpfocus(idump),stat=ier)
      call ftgkys(unit,'FOTRANSL',focustranslationdirection,comment,   &
        status)
      call sic_upper(focustranslationdirection)
      raw(i1)%subref(firstifb:lastifb)%focustransl   &
        = focustranslationdirection
      call ftgkyd(unit,'FOOFFSET',focusoffset,comment,status)
      do ifb = firstifb, lastifb
         mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,1)   &
           = mnt(firstifb)%header%focobs_x_y_z(1)
         mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,2)   &
           = mnt(firstifb)%header%focobs_x_y_z(2)
         mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,3)   &
           = mnt(firstifb)%header%focobs_x_y_z(3)
         if (index(focustranslationdirection,'X').ne.0) then
            mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,1) =   &
              mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,1)+focusoffset
         else if (index(focustranslationdirection,'Y').ne.0) then
            mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,2) =   &
              mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,2)+focusoffset
         else if (index(focustranslationdirection,'Z').ne.0) then
            mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,3) =   &
              mnt(ifb)%data%dfocus_x_y_z(idump1:idump2,3)+focusoffset
         endif
      enddo

      call ftgcno(unit,.false.,'FOCUS_X',idcol,status)
      do icol = idcol, idcol+2
         call ftgcfd(unit,icol,1,1,idump,tmpfocus,flagvals,anynull,   &
           status)
         do ifb = firstifb, lastifb
            mnt(ifb)%data%focus_x_y_z(idump1:idump2,icol-idcol+1)   &
              = tmpfocus(:)
         enddo
      enddo
      call ftgcno(unit,.false.,'PHI_X',idcol,status)
      do icol = idcol, idcol+2
         call ftgcfd(unit,icol,1,1,idump,tmpfocus,flagvals,anynull,   &
           status)
         do ifb = firstifb, lastifb
            mnt(ifb)%data%phi_x_y_z(idump1:idump2,icol-idcol+1)   &
              = tmpfocus(:)
         enddo
      enddo
      call ftgcno(unit,.false.,'MJD',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,tmpfocus,flagvals,anynull,   &
        status)
      do ifb = firstifb, lastifb
         mnt(ifb)%data%focus_x_y_z(idump1:idump2,4) = tmpfocus(:)
         mnt(ifb)%data%subscansubref(idump1:idump2) = i
      enddo
      raw(i1)%subref(firstifb)%subscanstart =   &
        max(   &
            raw(i1)%subref(firstifb)%subscanstart,   &
            mnt(firstifb)%data%focus_x_y_z(idump1,4)   &
           )
      raw(i1)%subref(firstifb)%subscanend =   &
        min(   &
            raw(i1)%subref(firstifb)%subscanend,   &
            mnt(firstifb)%data%focus_x_y_z(idump2,4)   &
           )
      raw(i1)%subref(firstifb+1:lastifb) = raw(i1)%subref(firstifb)
   !
   enddo subscanloop3
   !
   idump2 = 0
   idump4 = 0
   if (allocated(fastdap)) deallocate(fastdap,stat=ier)
   if (allocated(slowdap)) deallocate(slowdap,stat=ier)
   !
   allocate(fastdap(ndumpantennafast),slowdap(ndumpantenna),   &
     stat=ier)
   !
   subscanloop4: do i = subscanRange(1), subscanRange(2)
      i1 = i-subscanRange(1)+1
      j = idxstart+idxantenna+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      !
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      !
      call ftgkyj(unit,'NAXIS2',idump,comment,status)
      call ftgkys(unit,'SUBSTYPE',   &
        raw(i1)%antenna(firstifb)%subscantype,comment,   &
        status)
      idump1 = idump2+1
      idump2 = idump2+idump
      idump3 = idump4+1
      idump4 = idump4+idump*tracerate
      if (allocated(flagvals)) deallocate(flagvals)
      allocate(flagvals(idump),stat=ier)
      call ftgcno(unit,.false.,'MJD',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%mjd,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'LST',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%lst,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'LONGOFF',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%longoff,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'LATOFF',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%latoff,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'BASLONG',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%baslong,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'BASLAT',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%baslat,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'PARANGLE',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%parangle,flagvals,anynull,   &
        status)
      call ftgcno(unit,.false.,'TRACEFLAG',idcol,status)
      call ftgcfj(unit,idcol,1,1,idump,   &
        slowdap(idump1:idump2)%traceflag,flagvals,anynull,   &
        status)
      slowdap(idump1:idump2)%subscan = i
      !
      if (allocated(flagvals)) deallocate(flagvals)
      allocate(flagvals(idump*tracerate),stat=ier)
      call ftgcno(unit,.false.,'MJDFAST',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump*tracerate,   &
        fastdap(idump3:idump4)%encoder_az_el(3),   &
        flagvals,anynull,status)
      call ftgcno(unit,.false.,'AZIMUTH',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump*tracerate,   &
        fastdap(idump3:idump4)%encoder_az_el(1),   &
        flagvals,anynull,status)
      call ftgcno(unit,.false.,'TRACKING_AZ',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump*tracerate,   &
        fastdap(idump3:idump4)%tracking_az_el(1),   &
        flagvals,anynull,status)
      call ftgcno(unit,.false.,'ELEVATION',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump*tracerate,   &
        fastdap(idump3:idump4)%encoder_az_el(2),   &
        flagvals,anynull,status)
      call ftgcno(unit,.false.,'TRACKING_EL',idcol,status)
      call ftgcfd(unit,idcol,1,1,idump*tracerate,   &
        fastdap(idump3:idump4)%tracking_az_el(2),   &
        flagvals,anynull,status)
      fastdap(idump3:idump4)%subscanfast = i
   !
   enddo subscanloop4
   !
   if (firstifb.eq.1) then
      do m = 1, 3
         antdata%encoder_az_el(1:ndumpantennafast,m) &
 &       = fastdap(1:ndumpantennafast)%encoder_az_el(m)
      enddo
      antdata%encoder_az_el(1:ndumpantennafast,1:2) &
 &    = antdata%encoder_az_el(1:ndumpantennafast,1:2)*rad2deg
      do m = 1, 2
         antdata%tracking_az_el(1:ndumpantennafast,m) &
 &       = fastdap(1:ndumpantennafast)%tracking_az_el(m)*rad2deg
      enddo
      antdata%slowtrace(1:ndumpantenna,1)  &
 &    = slowdap(1:ndumpantenna)%longoff*rad2deg
      antdata%slowtrace(1:ndumpantenna,2)  &
 &    = slowdap(1:ndumpantenna)%latoff*rad2deg
      antdata%slowtrace(1:ndumpantenna,3) = slowdap(1:ndumpantenna)%mjd
   endif

   !
   j = 0
   i2 = 0
   i4 = 0
   do i = 1, ndumpantenna
      i1 = i2+1
      i2 = i2+tracerate
      if((slowdap(i)%traceflag.ne.2.and.                             &
          slowdap(i)%traceflag.eq.subscantrace(slowdap(i)%subscan))  &
         .or.index(tmpscantype,'CAL').ne.0.or..not.timingCheck) then
         j = j+1
         i3 = i4+1
         i4 = i4+tracerate
         do ifb = firstifb, lastifb
            mnt(ifb)%data%mjd(j) = slowdap(i)%mjd
            mnt(ifb)%data%lst(j) = slowdap(i)%lst
            mnt(ifb)%data%longoff(j) = slowdap(i)%longoff
            mnt(ifb)%data%latoff(j) = slowdap(i)%latoff
            mnt(ifb)%data%baslong(j) = slowdap(i)%baslong
            mnt(ifb)%data%baslat(j) = slowdap(i)%baslat
            mnt(ifb)%data%parangle(j) = slowdap(i)%parangle
            traceflag(j) = slowdap(i)%traceflag
            mnt(ifb)%data%subscan(j) = slowdap(i)%subscan
            do m = 1, 3
               mnt(ifb)%data%encoder_az_el(i3:i4,m)   &
                 = fastdap(i1:i2)%encoder_az_el(m)
            enddo
            do m = 1, 2
               mnt(ifb)%data%tracking_az_el(i3:i4,m)   &
                 = fastdap(i1:i2)%tracking_az_el(m)
            enddo
            mnt(ifb)%data%subscanfast(i3:i4)   &
              = fastdap(i1:i2)%subscanfast
         enddo
      endif
   enddo
   !
   ndumpantenna = ndumpantennanew
   ndumpantennafast = ndumpantennafastnew
   !
   do i = 1, nsubscan
      raw(i)%antenna(firstifb+1:lastifb) = raw(i)%antenna(firstifb)
   enddo
   !
   antennaTimingCheck: if (timingCheck) then
      do i = subscanRange(1), subscanRange(2)
         i1 = i-subscanRange(1)+1
         do j = 1, ndumpantenna
            if (mnt(firstifb)%data%subscan(j).eq.i) exit
         enddo
         raw(i1)%antenna(firstifb)%subscanstart   &
           = max(raw(i1)%antenna(firstifb)%subscanstart,   &
           mnt(firstifb)%data%mjd(j))
         do j = ndumpantenna, 1, -1
            if (mnt(firstifb)%data%subscan(j).eq.i) exit
         enddo
         raw(i1)%antenna(firstifb)%subscanend   &
           = min(raw(i1)%antenna(firstifb)%subscanend,   &
           mnt(firstifb)%data%mjd(j))
      enddo
      !
      do i = subscanRange(1), subscanRange(2)
         i1 = i-subscanRange(1)+1
         do j = 1, ndumpantennafast
            if (mnt(firstifb)%data%subscanfast(j).eq.i) exit
         enddo
         raw(i1)%antenna(firstifb)%subscanstart   &
           = max(raw(i1)%antenna(firstifb)%subscanstart,   &
           mnt(firstifb)%data%encoder_az_el(j,3))
         do j = ndumpantennafast, 1, -1
            if (mnt(firstifb)%data%subscanfast(j).eq.i) exit
         enddo
         raw(i1)%antenna(firstifb)%subscanend   &
           = min(raw(i1)%antenna(firstifb)%subscanend,   &
           mnt(firstifb)%data%encoder_az_el(j,3))
         raw(i1)%antenna(firstifb+1:lastifb) = raw(i1)%antenna(firstifb)
      enddo
      !
   endif antennaTimingCheck
   !
   !
   febe_loop1: do ifb = firstifb, lastifb
      !
      mnt(ifb)%data%longoff  = rad2deg*mnt(ifb)%data%longoff
      mnt(ifb)%data%latoff   = rad2deg*mnt(ifb)%data%latoff
      mnt(ifb)%data%baslong  = rad2deg*mnt(ifb)%data%baslong
      mnt(ifb)%data%baslat   = rad2deg*mnt(ifb)%data%baslat
      mnt(ifb)%data%parangle = rad2deg*mnt(ifb)%data%parangle
      mnt(ifb)%data%encoder_az_el(1:ndumpantennafast,1:2)   &
        = mnt(ifb)%data%encoder_az_el(1:ndumpantennafast,1:2)*rad2deg
      mnt(ifb)%data%tracking_az_el   &
        = mnt(ifb)%data%tracking_az_el*rad2deg
      mnt(ifb)%data%antenna_az_el(:)   &
        = mnt(ifb)%data%encoder_az_el(1,:)
      !
      !
      !
      fb(ifb)%data%usefeed(1) = 1
      fb(ifb)%data%reffeed = 1
      if (index(fb(ifb)%header%febe,'HER') /= 0 ) then
         fb(ifb)%data%reffeed = 5
         do i = 1, npix
            fb(ifb)%data%usefeed(1) = i
         enddo
         if (index(tmpfrontend,'VERTICAL').ne.0) then
            fb(ifb)%data%pola(1:npix) = 0.
         else if (index(tmpfrontend,'HORIZONTAL').ne.0) then
            fb(ifb)%data%pola(1:npix) = 90.
         endif
         !
         posanghera = fb(ifb)%header%dewang/rad2deg
         if (index(fb(ifb)%header%dewrtmod,'CABIN').ne.0) then
            fb(ifb)%data%feedoffx   &
              =  xhera(:)*cos(posanghera)-yhera(:)*sin(posanghera)
            fb(ifb)%data%feedoffy   &
              =  xhera(:)*sin(posanghera)+yhera(:)*cos(posanghera)
         else if (index(fb(ifb)%header%dewrtmod,'HORIZ').ne.0) then
            fb(ifb)%data%feedoffx   &
              =  xhera(:)*cos(posanghera)-yhera(:)*sin(posanghera)
            fb(ifb)%data%feedoffy   &
              =  xhera(:)*sin(posanghera)+yhera(:)*cos(posanghera)
         else if (index(fb(ifb)%header%dewrtmod,'EQUA').ne.0) then
            fb(ifb)%data%feedoffx   &
              = -xhera(:)*cos(posanghera)+yhera(:)*sin(posanghera)
            fb(ifb)%data%feedoffy   &
              =  xhera(:)*sin(posanghera)+yhera(:)*cos(posanghera)
         else
            fb(ifb)%data%feedoffx = 0.
            fb(ifb)%data%feedoffy = 0.
         endif
         fb(ifb)%data%feedoffx = fb(ifb)%data%feedoffx(:)/3.6d+3
         fb(ifb)%data%feedoffy = fb(ifb)%data%feedoffy(:)/3.6d+3
      !
      else
         if (index(tmpfrontend,'H').eq.1) then
            fb(ifb)%data%pola(1) = 90.
         else if (index(tmpfrontend,'V').eq.1) then
            fb(ifb)%data%pola(1) = 0.
         endif
         fb(ifb)%data%feedoffx(1) = 0.
         fb(ifb)%data%feedoffy(1) = 0.
      endif
   !
   enddo febe_loop1
   !
   hdutype = 2
   call ftmnhd(unit,hdutype,'IMBF-scan',0,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   call ftgkyd(unit,'THOT',tmpcalib,comment,status)
   do ifb = firstifb, lastifb
      mnt(ifb)%data%thotcold(1,1) = tmpcalib
   enddo
   call ftgkyd(unit,'REFRACTI',tmpcalib,comment,status)
   do ifb = firstifb, lastifb
      mnt(ifb)%data%refractio(1) = tmpcalib
   enddo
   call ftgkyd(unit,'TEMPERAT',tmpcalib,comment,status)
   if (status.ne.0) then
      status = 0
      call ftgkyd(unit,'TAMBIENT',tmpcalib,comment,status)
   endif
   do ifb = firstifb, lastifb
      mnt(ifb)%data%tamb_p_humid(1,1) = tmpcalib
   enddo
   call ftgkyd(unit,'PRESSURE',tmpcalib,comment,status)
   do ifb = firstifb, lastifb
      mnt(ifb)%data%tamb_p_humid(1,2) = tmpcalib
   enddo
   call ftgkyd(unit,'HUMIDITY',tmpcalib,comment,status)
   do ifb = firstifb, lastifb
      mnt(ifb)%data%tamb_p_humid(1,3) = tmpcalib
   enddo
   !
   !
   call ftgkyd(unit,'WINDDIR',tmpcalib,comment,status)
   if (status /= 0) then
      status = 0
      do ifb = firstifb, lastifb
         mnt(ifb)%data%wind_dir_vavg_vmax(1,1:3) = 0.0
      enddo
   else
      do ifb = firstifb, lastifb
         mnt(ifb)%data%wind_dir_vavg_vmax(1,1) = tmpcalib
      enddo
      call ftgkyd(unit,'WINDVEL',tmpcalib,comment,status)
      do ifb = firstifb, lastifb
         mnt(ifb)%data%wind_dir_vavg_vmax(1,2) = tmpcalib
      enddo
      call ftgkyd(unit,'WINDVELM',tmpcalib,comment,status)
      do ifb = firstifb, lastifb
         mnt(ifb)%data%wind_dir_vavg_vmax(1,3) = tmpcalib
      enddo
   endif
   !
   !
   hdutype = 2
   call ftmnhd(unit,hdutype,'IMBF-antenna',0,status)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      return
   endif
   call ftgkyj(unit,'SCANNUM',mnt(firstifb)%header%scannum,comment,   &
     status)
   call ftgkys(unit,'DATE-OBS',mnt(firstifb)%header%date_obs,comment,   &
     status)
   mnt(firstifb)%header%obsnum = currentindex
   !
   do ifb = firstifb+1, lastifb
      mnt(ifb)%header = mnt(firstifb)%header
   enddo
   do ifb = firstifb, lastifb
      mnt(ifb)%data%thotcold(1,2) = tcoldmon(ifb)
   enddo
   !
   nrecords = 0
   hdutype = 2
   do i = subscanRange(1), subscanRange(2) 
      j = idxstart+idxbackend+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      if (i.eq.1) then
         !
         call ftgkys(unit,'TFORM3',dataformat,comment,status)
         call sic_upper(dataformat)
         !
         call ftgkyj(unit,'CHANNELS',allchannels,comment,status)
         if (allocated(iddump)) deallocate(iddump,stat=ier)
         allocate(iddump(allchannels,5),stat=ier)
         if (allocated(flagvals)) deallocate(flagvals,stat=ier)
         allocate(flagvals(allchannels),stat=ier)
         if (allocated(intdata)) deallocate(intdata,stat=ier)
         if (allocated(realdata)) deallocate(realdata,stat=ier)
         if (allocated(doubledata)) deallocate(doubledata,stat=ier)
         if (index(dataformat,'J').ne.0) then
            allocate(intdata(allchannels),stat=ier)
         else if (index(dataformat,'E').ne.0) then
            allocate(realdata(allchannels),stat=ier)
         else if (index(dataformat,'D').ne.0) then
            allocate(doubledata(allchannels),stat=ier)
         endif
      endif
      call ftgkyj(unit,'NAXIS2',idump,comment,status)
      !
      if (idump.eq.0) then
         write(subscanstring,'(I3)') i
         j = index(fb(firstIfb)%header%febe,' ')
         tmpbackend(1:5) = fb(firstIfb)%header%febe(j+1:j+5)
         call gagout('W-GET: no '//tmpbackend(1:5)//          &
                     ' data in subscan '//subscanstring(1:3)//'.')
      endif
      !
      if (imbftsve.lt.1.2)   &
        call ftgkyj(unit,'NPHASES',nphases,comment,status)
      nrecords = nrecords+int(idump/nphases)
   !
   enddo
   !
   if (nrecords.eq.0) then
      status = 0
      call ftclos(unit,status)
      call ftfiou(-1,status)
      j = index(fb(firstIfb)%header%febe,' ')
      tmpbackend(1:5) = fb(firstIfb)%header%febe(j+1:j+5)
      call gagout('W-GET: no '//tmpbackend(1:5)//' data in this scan.')
      call sic_upper(tmpbackend)
      if (index(tmpbackend(1:5),'VESPA').ne.0.or.index(tmpbackend(1:5),'WILMA').ne.0) &
 &       error = .true.
      return
   endif
   !
   if (index(tmpbackend,'ABBA').eq.0) then
      !
      do i = 1, nrowbackendtable
         !
         ifb = firstifb+irank(band(i))-1
         if (index(tmpbackend,'CONT').ne.0) then
            iddump(i,1) = ifb
            iddump(i,2) = baseband(i)
            iddump(i,3) = pixel(i)
            iddump(i,4) = 1
         else if (index(tmpbackend,'BBC').ne.0) then
            iddump(i,1) = ifb
            iddump(i,2) = baseband(i)
            iddump(i,3) = pixel(i)
            iddump(i,4) = 1
         else if (index(tmpbackend,'NBC').ne.0) then
            iddump(i,1) = ifb
            iddump(i,2) = baseband(i)
            iddump(i,3) = pixel(i)
            iddump(i,4) = 1
         else
            do j = refchan(i), refchan(i)+chans(i)-1
               iddump(j,1) = ifb
               iddump(j,2) = baseband(i)
               iddump(j,3) = pixel(i)
               iddump(j,4) = j-refchan(i)+1
               if (polmode) then
                  if (index(polar(i),'IMAG').ne.0.and.   &
                      index(rec1(i),'A').ne.0.and.index(rec2(i),'B')   &
                      .ne.0) then
                     iddump(j,5) = -1
                  else if (index(polar(i),'IMAG').ne.0.and.   &
                           index(rec1(i),'C').ne.0.and.index(rec2(i),'D')   &
                           .ne.0) then
                     iddump(j,5) = -1
                  else
                     iddump(j,5) = 1
                  endif
               endif
            enddo
         endif
      !
      enddo
   !
   else if (index(tmpbackend,'ABBA').ne.0) then
      !
      iddump(1:allchannels,1) = 1
      iddump(1:allchannels,2) = 1
      do m = 1, allchannels
         iddump(m,3) = m
      enddo
      iddump(1:allchannels,4) = 1
      iddump(1:allchannels,5) = 1
   !
   endif
   !
   !
   !
   do jfb = 1, lastifb-firstifb+1
      !
      if (index(tmpbackend,'ABBA').ne.0) then
         ifb = jfb
      else
         ifb = firstifb+irank(jfb)-1
      endif
      !
      fmin = 1.d12
      fmax = 0.d0
      !
      nbd = fb(ifb)%header%febeband
      npix = fb(ifb)%header%febefeed
      nphases = fb(ifb)%header%nphases
      do ibd = 1, nbd
         do i = 1, nrowbackendtable
            if (index(tmpbackend,'CONT').ne.0.or.   &
                index(tmpbackend,'BBC').ne.0.or.   &
                index(tmpbackend,'NBC').ne.0.or.   &
                index(tmpbackend,'ABBA').ne.0) then
               j = i
            else
               j = refchan(i)
            endif
            if (iddump(j,1).eq.ifb.and.iddump(j,2).eq.ibd) exit
         enddo
         ar(ifb)%header(ibd)%channels = chans(i)
         ar(ifb)%header(ibd)%usedchan = used(i)
         ar(ifb)%header(ibd)%dropchan = dropped(i)
         ar(ifb)%header(ibd)%baseband = ibd
         ar(ifb)%header(ibd)%crvl4f_2   &
           = reffreq(i)*1.d6   &
            +ar(ifb)%header(ibd)%restfreq   &
            -fb(ifb)%header%ifcenter
         aux = spacing(i)*1.e6
         ar(ifb)%header(ibd)%cd4f_21 = aux
         ar(ifb)%header(ibd)%bandwid = abs(used(i)*aux)
         !
         if (index(tmpbackend,'4MHZ').ne.0.or.   &
             index(tmpbackend,'1MHZ').ne.0.or.   &
             index(tmpbackend,'100K').ne.0.or.   &
             index(tmpbackend,'BBC').ne.0.or.   &
             index(tmpbackend,'NBC').ne.0.or.   &
             index(tmpbackend,'CONT').ne.0) then
            ar(ifb)%header(ibd)%freqres = ar(ifb)%header(ibd)%cd4f_21
         else               ! for parabolic apodization (Welch window)
            ar(ifb)%header(ibd)%freqres   &
              = 1.59*ar(ifb)%header(ibd)%cd4f_21
         endif
         ar(ifb)%header(ibd)%cd4r_21   &
           = -ar(ifb)%header(ibd)%cd4f_21*clight   &
           /ar(ifb)%header(ibd)%restfreq
         ar(ifb)%header(ibd)%cuni4f_2 = 'Hz'
         ar(ifb)%header(ibd)%cuni4r_2 = 'km/s'
         !
         ar(ifb)%header(ibd)%vsou4r_2 = velosys
         ar(ifb)%header(ibd)%spec4r_2 = specsys
         !
         ar(ifb)%header(ibd)%crvl4r_2   &
           = -(reffreq(i)*1.d6-fb(ifb)%header%ifcenter)   &
              /ar(ifb)%header(ibd)%restfreq*clight+velosys
         ar(ifb)%header(ibd)%crpx4f_2 = 1
         ar(ifb)%header(ibd)%crpx4r_2 = 1
         !
         if (ar(ifb)%header(ibd)%cd4f_21.gt.0) then
            f1 = ar(ifb)%header(ibd)%crvl4f_2   &
                +(1+ar(ifb)%header(ibd)%dropchan   &
                   -ar(ifb)%header(ibd)%crpx4f_2)   &
                *ar(ifb)%header(ibd)%cd4f_21
            f2 = ar(ifb)%header(ibd)%crvl4f_2   &
                +(ar(ifb)%header(ibd)%dropchan+used(i)   &
                 -ar(ifb)%header(ibd)%crpx4f_2)   &
                 *ar(ifb)%header(ibd)%cd4f_21
         else
            f2 = ar(ifb)%header(ibd)%crvl4f_2   &
                +(1+ar(ifb)%header(ibd)%dropchan   &
                   -ar(ifb)%header(ibd)%crpx4f_2)   &
                 *ar(ifb)%header(ibd)%cd4f_21
            f1 = ar(ifb)%header(ibd)%crvl4f_2   &
                 +(ar(ifb)%header(ibd)%dropchan   &
                   +used(i)-ar(ifb)%header(ibd)%crpx4f_2)   &
                 *ar(ifb)%header(ibd)%cd4f_21
         endif
         fmin = min(fmin,f1)
         fmax = max(fmax,f2)
         !
         nchan = ar(ifb)%header(ibd)%channels
         allocate(   &
           ar(ifb)%data(ibd)%mjd(nrecords*nphases),   &
           ar(ifb)%data(ibd)%integtim(nrecords*nphases),   &
           ar(ifb)%data(ibd)%iswitch(nrecords,nphases),   &
           ar(ifb)%data(ibd)%data(npix,nchan,nrecords,nphases),   &
           stat=ier)
      !
      enddo
      !
      if (index(tmpbackend,'100K').ne.0) then
         if (ar(ifb)%header(1)%channels.eq.256) then
            dt(ifb)%header%channels = 253
         else
            dt(ifb)%header%channels = ar(ifb)%header(1)%channels
         endif
      else if (index(tmpbackend,'ABBA').ne.0) then
         dt(ifb)%header%channels = 1
      else
         dt(ifb)%header%channels   &
           = (fmax-fmin)/abs(ar(ifb)%header(1)%cd4f_21)+1
      endif
      !
      if (index(tmpscantype,'CAL') /= 0 ) then
         gn(ifb)%febe = fb(ifb)%header%febe
         mxchan = 0
         do ibd = 1, nbd
            nchan = ar(ifb)%header(ibd)%channels
            mxchan = max(mxchan,nchan)
         enddo

         call sic_get_logi('calByChannel',calbychannel,error)
         if (calbychannel) then
            call sic_get_inte('ncalchan',ncalchan,error)
            nxchan = ceiling(mxchan/float(ncalchan))
         else
            nxchan = 1
         endif

         allocate(gn(ifb)%crvl4f_2(nbd),                    &
                  gn(ifb)%channels(nbd),                    &
                  gn(ifb)%cd4f_21(nbd),                     &
                  stat=ier)
         allocate(gn(ifb)%tauzen(nbd,npix,nxchan),          &
                  gn(ifb)%tauzenimage(nbd,npix,nxchan),     &
                  gn(ifb)%tauzendry(nbd,npix,nxchan),       &
                  gn(ifb)%tauzenimagedry(nbd,npix,nxchan),  &
                  gn(ifb)%tauzenwet(nbd,npix,nxchan),       &
                  gn(ifb)%tauzenimagewet(nbd,npix,nxchan),  &
                  gn(ifb)%tatms(nbd,npix,nxchan),           &
                  gn(ifb)%tatmi(nbd,npix,nxchan),           &
                  gn(ifb)%temis(nbd,npix,nxchan),           &
                  gn(ifb)%temii(nbd,npix,nxchan),           &
                  gn(ifb)%tcal(nbd,npix,nxchan),            &
                  gn(ifb)%trx(nbd,npix,nxchan),             &
                  gn(ifb)%tsys(nbd,npix,nxchan),            &
                  gn(ifb)%h2omm(nbd,npix,nxchan),           &
                  stat=ier)
         allocate(gn(ifb)%gainarray(nbd,npix,mxchan),       &
                  gn(ifb)%gainimage(nbd,npix,mxchan),       &
                  gn(ifb)%psky(nbd,npix,mxchan),            &
                  gn(ifb)%phot(nbd,npix,mxchan),            &
                  gn(ifb)%pcold(nbd,npix,mxchan),           &
                  gn(ifb)%phasearray(nbd,npix,mxchan),      &
                  gn(ifb)%pgrid(nbd,npix,mxchan),           &
                  stat=ier)
         gn(ifb)%tsys = -1.
         gn(ifb)%trx  = -1.
         gn(ifb)%tcal = -1.
         gn(ifb)%gainimage(:,:,:)  = 0.0d0
         gn(ifb)%phasearray(:,:,:) = 0.0d0
         if (index(tmpswitchmode,'FREQ').ne.0) then
            allocate(gn(ifb+nfb)%crvl4f_2(nbd),                   &
                     gn(ifb+nfb)%channels(nbd),                   &
                     gn(ifb+nfb)%cd4f_21(nbd),                    &
                     stat=ier)
            allocate(gn(ifb+nfb)%tauzen(nbd,npix,nxchan),         &
                     gn(ifb+nfb)%tauzenimage(nbd,npix,nxchan),    &
                     gn(ifb+nfb)%tauzendry(nbd,npix,nxchan),      &
                     gn(ifb+nfb)%tauzenimagedry(nbd,npix,nxchan), &
                     gn(ifb+nfb)%tauzenwet(nbd,npix,nxchan),      &
                     gn(ifb+nfb)%tauzenimagewet(nbd,npix,nxchan), &
                     gn(ifb+nfb)%tatms(nbd,npix,nxchan),          &
                     gn(ifb+nfb)%tatmi(nbd,npix,nxchan),          &
                     gn(ifb+nfb)%temis(nbd,npix,nxchan),          &
                     gn(ifb+nfb)%temii(nbd,npix,nxchan),          &
                     gn(ifb+nfb)%tcal(nbd,npix,nxchan),           &
                     gn(ifb+nfb)%trx(nbd,npix,nxchan),            &
                     gn(ifb+nfb)%tsys(nbd,npix,nxchan),           &
                     gn(ifb+nfb)%h2omm(nbd,npix,nxchan),          &
                     stat=ier)
            allocate(gn(ifb+nfb)%gainarray(nbd,npix,mxchan),      &
                     gn(ifb+nfb)%gainimage(nbd,npix,mxchan),      &
                     gn(ifb+nfb)%psky(nbd,npix,mxchan),           &
                     gn(ifb+nfb)%phot(nbd,npix,mxchan),           &
                     gn(ifb+nfb)%pcold(nbd,npix,mxchan),          &
                     gn(ifb+nfb)%phasearray(nbd,npix,mxchan),     &
                     gn(ifb+nfb)%pgrid(nbd,npix,mxchan),          &
                     stat=ier)
            gn(ifb+nfb)%tsys = -1.
            gn(ifb+nfb)%trx  = -1.
            gn(ifb+nfb)%tcal = -1.
            gn(ifb+nfb)%gainimage(:,:,:)  = 0.0d0
            gn(ifb+nfb)%phasearray(:,:,:) = 0.0d0
         endif
         !
         !
         do ibd = 1, fb(ifb)%header%febeband
            gn(ifb)%crvl4f_2(ibd) = ar(ifb)%header(ibd)%crvl4f_2
            gn(ifb)%channels(ibd) = ar(ifb)%header(ibd)%channels
            gn(ifb)%cd4f_21(ibd) = ar(ifb)%header(ibd)%cd4f_21
            if (index(tmpswitchmode,'FREQ').ne.0) then
               gn(ifb+nfb)%crvl4f_2(ibd) = ar(ifb)%header(ibd)%crvl4f_2
               gn(ifb+nfb)%channels(ibd) = ar(ifb)%header(ibd)%channels
               gn(ifb+nfb)%cd4f_21(ibd) = ar(ifb)%header(ibd)%cd4f_21
            endif
         enddo
      !
      endif
      dt(ifb)%header%scannum = sc%header%scannum
      dt(ifb)%header%obsnum = currentindex
      dt(ifb)%header%date_obs = fb(ifb)%header%date_obs
      dt(ifb)%header%lst = sc%header%lst
      !
      allocate(dt(ifb)%data%integnum(nrecords),   &
               dt(ifb)%data%subscan(nrecords),   &
               stat=ier)
   !
   enddo
   !
   !
   i1 = 0
   i2 = 0
   subscanloop: do i = subscanRange(1), subscanRange(2) 
      j = idxstart+idxbackend+(i-1)*next
      call ftmahd(unit,j,hdutype,status)
      !
      call ftgcno(unit,.false.,'MJD',idcol_mjd,status)
      if (index(tmpbackend,'ABBA').eq.0)   &
        call ftgcno(unit,.false.,'INTEGTIM',idcol_integtim,status)
      call ftgcno(unit,.false.,'ISWITCH',idcol_iswitch,status)
      call ftgcno(unit,.false.,'DATA',idcol_data,status)
      !
      if (status /= 0) then
         call cfitsio_errormsg(status)
         error = .true.
         status = 0
         call ftclos(unit,status)
         call ftfiou(-1,status)
         return
      endif
      call ftgkyj(unit,'NAXIS2',idump,comment,status)
      call ftgkyj(unit,'NPHASES',nphases,comment,status)
      fb(firstifb:lastifb)%header%nphases = nphases
      ndump = nphases*int(idump/nphases)
      dumploop: do k = 1, ndump, nphases
         i1 = i1+1
         do ifb = firstifb, lastifb
            dt(ifb)%data%integnum(i1) = i1
            dt(ifb)%data%subscan(i1) = i
         enddo
         phaseloop: do l = 1, nphases
            irow = k+l-1
            i2 = i2+1
            call ftgcfd(unit,idcol_mjd,irow,1,1,pmjd,   &
              flagscalar,anynull,status)
            !
            if (index(tmpbackend,'ABBA').eq.0)   &
              call ftgcfd(unit,idcol_integtim,irow,1,1,pintegtim,   &
                          flagscalar,anynull,status)
            call ftgcfj(unit,idcol_iswitch,irow,1,1,pswitch,   &
                        flagscalar,anynull,status)
            if (index(dataformat,'J').ne.0) then
               call ftgcfj(unit,idcol_data,irow,1,allchannels,   &
                 intdata,flagvals,anynull,status)
            else if (index(dataformat,'E').ne.0) then
               call ftgcfe(unit,idcol_data,irow,1,allchannels,   &
                 realdata,flagvals,anynull,status)
            else if (index(dataformat,'D').ne.0) then
               call ftgcfd(unit,idcol_data,irow,1,allchannels,   &
                 doubledata,flagvals,anynull,status)
            endif
            do m = 1, allchannels
               ifb = iddump(m,1)
               ibd = iddump(m,2)
               ipix = iddump(m,3)
               ichan = iddump(m,4)
               if (index(dataformat,'J').ne.0) then
                  if (polmode) then
                     ar(ifb)%data(ibd)%data(ipix,ichan,i1,l)   &
                       = intdata(m)*iddump(m,5)
                  else
                     ar(ifb)%data(ibd)%data(ipix,ichan,i1,l)   &
                       = intdata(m)
                  endif
               else if (index(dataformat,'E').ne.0) then
                  if (polmode) then
                     ar(ifb)%data(ibd)%data(ipix,ichan,i1,l)   &
                       = realdata(m)*iddump(m,5)
                  else
                     ar(ifb)%data(ibd)%data(ipix,ichan,i1,l)   &
                       = realdata(m)
                  endif
               else if (index(dataformat,'D').ne.0) then
                  if (polmode) then
                     ar(ifb)%data(ibd)%data(ipix,ichan,i1,l)   &
                       = doubledata(m)*iddump(m,5)
                  else
                     ar(ifb)%data(ibd)%data(ipix,ichan,i1,l)   &
                       = doubledata(m)
                  endif
               endif
            enddo
            do ifb = firstifb, lastifb
               do ibd = 1, fb(ifb)%header%febeband
                  ar(ifb)%data(ibd)%mjd(i2) = pmjd
                  ar(ifb)%data(ibd)%integtim(i2) = pintegtim
               enddo
            enddo
            if ((subscantrace(i).eq.1.and.nphases.gt.1)   &
              .or.   &
              index(tmpscantype,'POINT').ne.0   &
              .or.   &
              index(tmpscantype,'FOCUS').ne.0   &
              ) then
               if (index(fb(firstifb)%header%swtchmod,'beam')   &
                 .ne.0) then
                  if (pswitch.eq.1.or.pswitch.eq.3) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'SKY '
                  else if (pswitch.eq.2.or.pswitch.eq.4) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'LOAD'
                  endif
               else if (index(fb(firstifb)%header%swtchmod,'wob')   &
                 .ne.0) then
                  if (pswitch.eq.1.or.pswitch.eq.3) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'ON  '
                  else if (pswitch.eq.2.or.pswitch.eq.4) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'OFF '
                  endif
               endif
            else if (subscantrace(i).eq.0.and.nphases.gt.1) then
               if (index(fb(firstifb)%header%swtchmod,'beam')   &
                 .ne.0) then
                  if (pswitch.eq.1.or.pswitch.eq.3) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'SKY '
                  else if (pswitch.eq.2.or.pswitch.eq.4) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'LOAD'
                  endif
               else if (index(fb(firstifb)%header%swtchmod,'wob')   &
                 .ne.0) then
                  if (pswitch.eq.1.or.pswitch.eq.3) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'OFF '
                  else if (pswitch.eq.2.or.pswitch.eq.4) then
                     ar(firstifb)%data(1)%iswitch(i1,l) = 'ON  '
                  endif
               endif
            endif
            if (index(fb(firstifb)%header%swtchmod,'freq').ne.0) then
               if (pswitch.eq.1) then
                  ar(firstifb)%data(1)%iswitch(i1,l) = 'FLO'
               else if (pswitch.eq.2) then
                  ar(firstifb)%data(1)%iswitch(i1,l) = 'FHI'
               endif
            endif
            do ifb = firstifb, lastifb
               do ibd = 1, fb(ifb)%header%febeband
                  ar(ifb)%data(ibd)%iswitch(i1,l)   &
                    = ar(firstifb)%data(1)%iswitch(i1,l)
               enddo
            enddo
         enddo phaseloop
      enddo dumploop
   enddo subscanloop
   !
   if (stepcompress.ne.0) then
      dumptime   &
        = sum(ar(firstifb)%data(1)%integtim(:))/(nrecords*nphases)
      nbin = int(stepcompress/dumptime)
      dumptime = dumptime*nbin
      write(string,'(f6.3)') dumptime
      if (nbin.eq.0) then
         call gagout('I-GET: compression timestep too short,'   &
                   //' nothing changed.')
         nbin = 1
      endif
      if (abs(dumptime-stepcompress).gt.0.01)   &
        call gagout('I-GET: dump time rounded to '   &
                   //string//' s.')
      nrecnew = int(nrecords/nbin)
      allocate(   &
        tmpsubscan(nrecnew),   &
        artmp%mjd(nrecnew*nphases),   &
        artmp%integtim(nrecnew*nphases),   &
        artmp%iswitch(nrecnew,nphases),   &
        artmp%data(npix,nchan,nrecnew,nphases),   &
        stat=ier   &
        )
      allocate(compressmask(nbin),stat=ier)
      fbloop: do ifb = firstifb, lastifb
         bdloop: do ibd = 1, fb(ifb)%header%febeband
            i2 = 0
            i4 = 0
            i6 = 0
            recloop: do j = 1, nrecnew
               i1 = i2+1
               i2 = i2+nbin
               if (ibd.eq.1) tmpsubscan(j) = dt(ifb)%data%subscan(i1)
               i3 = i4+1
               i4 = i4+nbin*nphases
               i5 = i6+1
               i6 = i6+nphases
               do ipix = 1, npix
                  do ichan = 1, nchan
                     do iph = 1, nphases
                        compressmask   &
                          =ar(ifb)%data(ibd)%data(ipix,ichan,i1:i2,iph)   &
                          .ne.blankingraw
                        artmp%data(ipix,ichan,j,iph)   &
                          = sum(   &
                          ar(ifb)%data(ibd)%data(ipix,ichan,i1:i2,iph),   &
                          compressmask)/count(compressmask)
                     enddo
                  enddo
               enddo
               if (ifb.eq.firstifb.and.ibd.eq.1) then
                  do k = 1, nphases
                     artmp%mjd(i5+k-1)   &
                       = ar(ifb)%data(ibd)%mjd(i4+1-k)
                     artmp%integtim(i5+k-1)   &
                       = sum(ar(ifb)%data(ibd)%integtim(i3:i4))
                  enddo
                  artmp%iswitch(j,:)= ar(ifb)%data(ibd)%iswitch(i1,:)
               endif
            enddo recloop
            deallocate(ar(ifb)%data(ibd)%mjd,   &
                       ar(ifb)%data(ibd)%integtim,   &
                       ar(ifb)%data(ibd)%iswitch,   &
                       ar(ifb)%data(ibd)%data,   &
                       stat=ier)
            allocate(   &
              ar(ifb)%data(ibd)%mjd(nrecnew*nphases),   &
              ar(ifb)%data(ibd)%integtim(nrecnew*nphases),   &
              ar(ifb)%data(ibd)%iswitch(nrecnew,nphases),   &
              ar(ifb)%data(ibd)%data(npix,nchan,nrecnew,nphases),   &
              stat=ier)
            ar(ifb)%data(ibd)%mjd = artmp%mjd(:)
            ar(ifb)%data(ibd)%integtim = artmp%integtim(:)
            ar(ifb)%data(ibd)%iswitch = artmp%iswitch(:,:)
            ar(ifb)%data(ibd)%data = artmp%data(:,:,:,:)
         enddo bdloop
         deallocate(dt(ifb)%data%integnum,dt(ifb)%data%subscan,   &
           stat=ier)
         allocate(dt(ifb)%data%integnum(nrecnew),   &
                  dt(ifb)%data%subscan(nrecnew),   &
                  stat=ier)
         dt(ifb)%data%subscan = tmpsubscan(:)
         do j = 1, nrecnew
            dt(ifb)%data%integnum(j) = j
         enddo
      enddo fbloop
      deallocate(tmpsubscan,stat=ier)
      deallocate(artmp%data,artmp%iswitch,artmp%integtim,   &
                 artmp%mjd,stat=ier)
      deallocate(compressmask,stat=ier)
      nrecords = nrecnew
   endif
   !
   do i = subscanRange(1), subscanRange(2)
      i1 = i-subscanRange(1)+1
      if (raw(i1)%backend(firstifb)%subscanend   &
        .eq.raw(i1)%backend(firstifb)%subscanstart) then
         nphases = fb(firstifb)%header%nphases
         j = maxval(dt(firstifb)%data%integnum,   &
           dt(firstifb)%data%subscan.eq.i)
         raw(i1)%backend(firstifb)%subscanend   &
           = ar(firstifb)%data(1)%mjd(j*nphases)
      endif
   enddo
   !
   do ifb = firstifb, lastifb
      !
      allocate(dt(ifb)%data%nints(nrecords),   &
               dt(ifb)%data%lst(nrecords),   &
               dt(ifb)%data%longoff(nrecords),   &
               dt(ifb)%data%latoff(nrecords),   &
               dt(ifb)%data%azimuth(nrecords),   &
               dt(ifb)%data%elevatio(nrecords),   &
               dt(ifb)%data%cbaslong(nrecords),   &
               dt(ifb)%data%cbaslat(nrecords),   &
               dt(ifb)%data%baslong(nrecords),   &
               dt(ifb)%data%baslat(nrecords),   &
               dt(ifb)%data%parangle(nrecords),   &
               dt(ifb)%data%pc_11(nrecords),   &
               dt(ifb)%data%pc_12(nrecords),   &
               dt(ifb)%data%pc_21(nrecords),   &
               dt(ifb)%data%pc_22(nrecords),   &
               dt(ifb)%data%cr4k1(nrecords),   &
               dt(ifb)%data%cr4k2(nrecords),   &
               dt(ifb)%data%mcrval1(nrecords),   &
               dt(ifb)%data%mcrval2(nrecords),   &
               dt(ifb)%data%mlonpole(nrecords),   &
               dt(ifb)%data%mlatpole(nrecords),   &
               dt(ifb)%data%mjd(nrecords),   &
               dt(ifb)%data%midtime(nrecords),   &
               dt(ifb)%data%integtim(nrecords),   &
               dt(ifb)%data%dfocus_x_y_z(nrecords,3),   &
               dt(ifb)%data%focus_x_y_z(nrecords,3),   &
               dt(ifb)%data%dphi_x_y_z(nrecords,3),   &
               dt(ifb)%data%phi_x_y_z(nrecords,3),   &
               stat=ier)
      !
      nchan = dt(ifb)%header%channels
      npix = fb(ifb)%header%febefeed
      allocate(dt(ifb)%data%otfdata(npix,nchan,nrecords),   &
               dt(ifb)%data%rdata(npix,nchan),   &
               stat=ier)
      !
      dt(ifb)%data%longoff(1:nrecords) = 0
      dt(ifb)%data%latoff(1:nrecords) = 0
      dt(ifb)%data%nints(1:nrecords) = tracerate
      dt(ifb)%header%febe = fb(ifb)%header%febe
   enddo
   !
   !
   do ifb = firstifb, lastifb
      nphases = fb(ifb)%header%nphases
      do i = 1, nrecords
         dt(ifb)%data%mjd(i)   &
           = ar(ifb)%data(1)%mjd(i*nphases)
         dt(ifb)%data%midtime(i)   &
           = 0.5*(   &
                  dt(ifb)%data%mjd(i)   &
                  +ar(ifb)%data(1)%mjd((i-1)*nphases+1)   &
                  -sec2day*ar(ifb)%data(1)%integtim((i-1)*nphases+1)   &
                 )
         dt(ifb)%data%integtim(i)   &
           = sum(   &
                 ar(ifb)%data(1)%integtim((i-1)*nphases+1:i*nphases)   &
                )
      enddo
   enddo
   !
   !
   do ifb = firstifb, lastifb
      nbd = fb(ifb)%header%febeband
      if (stepcompress.ne.0) then
         nphases = fb(ifb)%header%nphases
         dt(ifb)%data%integtim = dt(ifb)%data%integtim(:)/nphases
         do ibd = 1, nbd
            ar(ifb)%data(ibd)%integtim   &
              = ar(ifb)%data(ibd)%integtim(:)/nphases
         enddo
      endif
      if (fb(ifb)%header%nphases.eq.1.and.   &
        index(tmpscantype,'CAL').eq.0) then
         do iobs = subscanRange(1), subscanRange(2)
            i1 = iobs-subscanRange(1)+1
            do i = 1, nbd
               do j = 1, nrecords
                  if (dt(ifb)%data%subscan(j).eq.iobs.and.   &
                    subscantrace(i1).eq.0) then
                     ar(ifb)%data(i)%iswitch(j,1) = 'ON  '
                  else if (dt(ifb)%data%subscan(j).eq.iobs.and.   &
                    subscantrace(i1).eq.1) then
                     ar(ifb)%data(i)%iswitch(j,1) = 'OFF '
                  else if (dt(ifb)%data%subscan(j).eq.iobs.and.   &
                    subscantrace(i1).eq.2) then
                     ar(ifb)%data(i)%iswitch(j,1) = 'NONE'
                  endif
               enddo
            enddo
         enddo
      endif
   enddo
   !
   !
   if (index(tmpscantype,'CAL') /= 0) then
      !
      do ifb = firstifb, lastifb
         nbd = fb(ifb)%header%febeband
         do iobs = subscanRange(1), subscanRange(2)
            !
            i1 = iobs-subscanRange(1)+1
            if (index(raw(i1)%antenna(ifb)%subscantype,'Sky').ne.0)   &
              then
               do i = 1, nbd
                  do j = 1, nrecords
                     if (dt(ifb)%data%subscan(j).eq.iobs) then
                        if (index(fb(firstifb)%header%swtchmod,'freq')   &
                          .ne.0) then
                           ar(ifb)%data(i)%iswitch(j,1)   &
                             = 'S'//ar(ifb)%data(i)%iswitch(j,1)
                           ar(ifb)%data(i)%iswitch(j,2)   &
                             = 'S'//ar(ifb)%data(i)%iswitch(j,2)
                        else
                           ar(ifb)%data(i)%iswitch(j,1) = 'SKY '
                        endif
                     endif
                  enddo
               enddo
            else if (index(raw(i1)%antenna(ifb)%subscantype,   &
              'Ambient').ne.0) then
               do i = 1, nbd
                  do j = 1, nrecords
                     if (dt(ifb)%data%subscan(j).eq.iobs) then
                        if (index(fb(firstifb)%header%swtchmod,'freq')   &
                          .ne.0) then
                           ar(ifb)%data(i)%iswitch(j,1)   &
                             = 'H'//ar(ifb)%data(i)%iswitch(j,1)
                           ar(ifb)%data(i)%iswitch(j,2)   &
                             = 'H'//ar(ifb)%data(i)%iswitch(j,2)
                        else
                           ar(ifb)%data(i)%iswitch(j,1) = 'HOT '
                        endif
                     endif
                  enddo
               enddo
            else if (index(raw(i1)%antenna(ifb)%subscantype,'Cold')   &
              .ne.0) then
               do i = 1, nbd
                  do j = 1, nrecords
                     if (dt(ifb)%data%subscan(j).eq.iobs) then
                        if (index(fb(firstifb)%header%swtchmod,'freq')   &
                          .ne.0) then
                           ar(ifb)%data(i)%iswitch(j,1)   &
                             = 'C'//ar(ifb)%data(i)%iswitch(j,1)
                           ar(ifb)%data(i)%iswitch(j,2)   &
                             = 'C'//ar(ifb)%data(i)%iswitch(j,2)
                        else
                           ar(ifb)%data(i)%iswitch(j,1) = 'COLD'
                        endif
                     endif
                  enddo
               enddo
            else if (index(raw(i1)%antenna(ifb)%subscantype,'Grid')   &
              .ne.0) then
               do i = 1, nbd
                  do j = 1, nrecords
                     if (dt(ifb)%data%subscan(j).eq.iobs) then
                        if (index(fb(firstifb)%header%swtchmod,'freq')   &
                          .ne.0) then
                           ar(ifb)%data(i)%iswitch(j,1)   &
                             = 'G'//ar(ifb)%data(i)%iswitch(j,1)
                           ar(ifb)%data(i)%iswitch(j,2)   &
                             = 'G'//ar(ifb)%data(i)%iswitch(j,2)
                        else
                           ar(ifb)%data(i)%iswitch(j,1) = 'GRID'
                        endif
                     endif
                  enddo
               enddo
            else
               do i = 1, nbd
                  do j = 1, nrecords
                     if (dt(ifb)%data%subscan(j).eq.iobs) then
                        if (index(fb(firstifb)%header%swtchmod,'freq')   &
                          .ne.0) then
                           ar(ifb)%data(i)%iswitch(j,1)   &
                             = 'N'//ar(ifb)%data(i)%iswitch(j,1)
                           ar(ifb)%data(i)%iswitch(j,2)   &
                             = 'N'//ar(ifb)%data(i)%iswitch(j,2)
                        else
                           ar(ifb)%data(i)%iswitch(j,1) = 'NONE'
                        endif
                     endif
                  enddo
               enddo
            endif
         enddo
      !
      enddo
   !
   endif
   !
   !
   if (lastifb.eq.nfb) then
      !
      ! check completeness of subscans
      !
      if (fb(nfb)%header%nphases.eq.1.and.                        &
          count(ar(nfb)%data(1)%iswitch(:,1).eq.'OFF ').eq.0.and. &
          index(tmpscantype,'CAL').eq.0)                          &
         call gagout('W-GET: total power data without sky reference')
      !
      prim  => pr
      scan  => sc
      febe  => fb
      if (cryoextension) then
         cryo  => crx
      else
         cryo => null()
      endif
      if (derotextension) then
         derot => drt
      else
         derot => null()
      endif
   endif
   !
   call ftclos(unit,status)
   call ftfiou(-1,status)
   !
   !
   tmpscantype = sc%header%scantype
   call sic_upper(tmpscantype)
   if (status /= 0) then
      call cfitsio_errormsg(status)
      error = .true.
      return
   else if (lastifb.eq.nfb) then
      if (allocated(newpar)) then 
         if (overrideFlag(1).or.overrideFlag(2)) then
            do ifb = 1, nfb
               if (size(mnt(ifb)%data%thotcold).eq.   &
                   size(newpar(ifb)%thotcold)) then
                  mnt(ifb)%data%thotcold = newpar(ifb)%thotcold
               else
                  call gagout('W-GET: shapes of THOTCOLD do not conform.')
                  call gagout('       Calibration parameters unchanged.')
               endif
            enddo
         endif
         if (overrideflag(6).or.overrideflag(7)) then
            do ifb = 1, nfb
               if (size(mnt(ifb)%data%tamb_p_humid).eq.   &
                   size(newpar(ifb)%tamb_p_humid)) then
                  mnt(ifb)%data%tamb_p_humid = newpar(ifb)%tamb_p_humid
               else
                  call gagout('W-GET: shapes of TAMB_P_HUMID do not conform.')
                  call gagout('       Calibration parameters unchanged.')
               endif
            enddo
         endif
         if (overrideflag(3)) then
            do ifb = 1, nfb
               if (size(fb(ifb)%data%etafss).eq.   &
                   size(newpar(ifb)%etafss)) then
                  fb(ifb)%data%etafss = newpar(ifb)%etafss
               else
                  call gagout('W-GET: shapes of ETAFSS do not conform.')
                  call gagout('       Calibration parameters unchanged.')
               endif
            enddo
         endif
         if (overrideflag(4)) then
            do ifb = 1, nfb
               if (size(fb(ifb)%data%beameff).eq.   &
                   size(newpar(ifb)%beameff)) then
                  fb(ifb)%data%beameff = newpar(ifb)%beameff
               else
                  call gagout('W-GET: shapes of BEAMEFF do not conform.')
                  call gagout('       Calibration parameters unchanged.')
               endif
            enddo
         endif
         if (overrideflag(5)) then
            do ifb = 1, nfb
               if (size(fb(ifb)%data%gainimag).eq.   &
                   size(newpar(ifb)%gainimag)) then
                  fb(ifb)%data%gainimag = newpar(ifb)%gainimag
               else
                  call gagout('W-GET: shapes of GAINIMAG do not conform.')
                  call gagout('       Calibration parameters unchanged.')
               endif
            enddo
         endif
      endif 
      call sic_get_logi('timingCheck',timingcheck,error)
      call sic_get_logi('traceExtrapolation',traceExtrapolation,error)
      if (timingCheck) then
         do ifb = 1, nfb
            call syncData(ifb,nfb,subscanRange,error)
         enddo
      else
         do ifb = 1, nfb
            call syncDataNew(ifb,nfb,subscanRange,error)
         enddo
      endif
      !
      data => databuf
      array => arraybuf
      mon => monbuf
      !
      if (index(tmpscantype,'CAL') /= 0 ) gains => gn
      !
      do i = 1, size(dt)
         call freedata(dt(i)%data,error)
      enddo
      deallocate(dt,stat=ier)
      !
      do i = 1, size(ar)
         do j = 1, size(ar(i)%header)
            call freearray(ar(i)%data(j),error)
         enddo
         deallocate(ar(i)%header, ar(i)%data,stat =ier)
      enddo
      deallocate(ar,stat=ier)
      !
      do i = 1, size(mnt)
         call freemon(mnt(i)%data,error)
      enddo
      deallocate(mnt,stat=ier)
      !
      nosky = .false.
      nrecords = size(array(1)%data(1)%iswitch,1)
      call computeoffset(nfb,noffset,nrecords,sysoff,tmpscantype,   &
        tmpswitchmode,nosky,error)
      if (error) return
      !
      ! check completeness of calibration scans
      !
      if (index(tmpscantype,'CAL').ne.0) then
         if (nsubscan.eq.1.or.  &
             (nsubscan.eq.2.and..not.nosky)) then
            call gagout('E-GET: incomplete calibration')
            error = .true.
            return
         endif
      endif
      !
      !
      if (nosky.and.index(tmpscantype,'CAL').ne.0.and.   &
        .not.polmode.and.maxval(data(1)%data%subscan).eq.4) then
         scan%header%scantype = 'calibImage'
         tmpscantype = 'CALIBIMAGE'
         if (.not.allocated(igains)) then
            allocate(igains(nfb),stat=ier)
            do ifb=1, nfb
               mxchan=0
               igains(ifb)%febe = febe(ifb)%header%febe
               nbd = febe(ifb)%header%febeband
               npix = febe(ifb)%header%febefeed
               do ibd = 1, nbd
                  nchan = array(ifb)%header(ibd)%channels
                  mxchan = max(nchan,mxchan)
               enddo
               allocate(igains(ifb)%gainimage(nbd,npix,mxchan),   &
                 stat=ier)
               igains(ifb)%gainimage = 0.d0
            enddo
         endif
         if (index(raw(1)%antenna(firstifb)%sbcalrec,'UNKNOWN').ne.0)   &
           then
            call gagout('W-GET: receiver for image gain calibration '   &
                      //'unknown.')
         else
            call gagout('I-GET: image gain calibration for '//   &
                        trim(raw(1)%antenna(firstifb)%sbcalrec)//'.')
         endif
         call gagout(' ')
         call gagout('Fe/Be          Pixel    gainImage')
         do ifb = 1, nfb
            tmpfrontend = febe(ifb)%header%febe
            call sic_upper(tmpfrontend)
            if (index(tmpfrontend,trim(raw(1)%antenna(ifb)%sbcalrec))   &
              .eq.0.and.   &
              index(raw(1)%antenna(ifb)%sbcalrec,'UNKNOWN')   &
              .eq.0) cycle
            nbd = febe(ifb)%header%febeband
            npix = febe(ifb)%header%febefeed
            do ipix = 1, npix
               gainimage = 0.
               photimagemean = 0.
               pcoldimagemean = 0.
               do ibd = 1, nbd
                  pcoldimage = 0.
                  pcoldsignal = 0.
                  photimage = 0.
                  photsignal = 0.
                  do ichan = array(ifb)%header(ibd)%dropchan+1,   &
                       array(ifb)%header(ibd)%dropchan   &
                       +array(ifb)%header(ibd)%usedchan
                     !
                     pcoldsignalnew = sum(   &
                       array(ifb)%data(ibd)%data(ipix,ichan,:,1),   &
                       data(ifb)%data%subscan(:).le.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'COLD')   &
                       /count(data(ifb)%data%subscan(:).le.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'COLD')
                     pcoldimagenew = sum(   &
                       array(ifb)%data(ibd)%data(ipix,ichan,:,1),   &
                       data(ifb)%data%subscan(:).gt.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'COLD')   &
                       /count(data(ifb)%data%subscan(:).gt.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'COLD')
                     photsignalnew = sum(   &
                       array(ifb)%data(ibd)%data(ipix,ichan,:,1),   &
                       data(ifb)%data%subscan(:).le.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'HOT')   &
                       /count(data(ifb)%data%subscan(:).le.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'HOT')
                     photimagenew = sum(   &
                       array(ifb)%data(ibd)%data(ipix,ichan,:,1),   &
                       data(ifb)%data%subscan(:).gt.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'HOT')   &
                       /count(data(ifb)%data%subscan(:).gt.2.and.   &
                       array(ifb)%data(ibd)%iswitch(:,1).eq.'HOT')
                     igains(ifb)%gainimage(ibd,ipix,ichan)   &
                       = (photimagenew-pcoldimagenew)   &
                       /(photsignalnew-pcoldsignalnew)
                     !
                     ! comment the following two lines in for new backends
                     !                         if (gains(ifb)%gainimage(ibd,ipix,ichan).ne.0)
                     !     &                   calByChannel = .true.
                     photimage   = photimage+photimagenew
                     pcoldimage  = pcoldimage+pcoldimagenew
                     photsignal  = photsignal+photsignalnew
                     pcoldsignal = pcoldsignal+pcoldsignalnew
                  enddo
                  photimagemean = photimagemean+photimage   &
                    /array(ifb)%header(ibd)%usedchan
                  pcoldimagemean = pcoldimagemean+pcoldimage   &
                    /array(ifb)%header(ibd)%usedchan
                  gainimage = gainimage+(photimage-pcoldimage)   &
                    /(photsignal-pcoldsignal)   &
                    /array(ifb)%header(ibd)%usedchan
               enddo
               gainimage = gainimage/nbd
               photimagemean  = photimagemean/nbd
               pcoldimagemean = pcoldimagemean/nbd
               if (photimagemean.le.pcoldimagemean) then
                  gainimage = 0.
                  call gagout('W-GET: image/signal ratio is too '   &
                            //'small to measure and set to zero.')
               endif
               write(message,'(T1,A13,T18,I1,T24,f9.4)')   &
                 febe(ifb)%header%febe(1:13), ipix, gainimage
               call gagout(message)
               write(message,'(T1,A26)') '                          '
               call gagout(message)
               write(message,'(T1,A8,T10,A4,T15,A5,T21,F9.4)')   &
                 'RECEIVER',febe(ifb)%header%febe(1:4),'/GAIN',   &
                 gainimage
               call gagout(message)
            enddo
         enddo
         do ifb = 1, nfb
            gains(ifb)%gainimage = igains(ifb)%gainimage
         enddo
      else if (nosky.and.index(tmpscantype,'CAL').ne.0) then
         call gagout(' ')
         call gagout('Fe/Be       Pixel   Trec [K]')
         do ifb = 1 ,nfb
            nbd = febe(ifb)%header%febeband
            npix = febe(ifb)%header%febefeed
            do ipix = 1, npix
               trec = 0
               do ibd = 1, nbd
                  nchan = array(ifb)%header(ibd)%usedchan
                  i1 = array(ifb)%header(ibd)%dropchan+1
                  i2 = array(ifb)%header(ibd)%dropchan   &
                      +array(ifb)%header(ibd)%usedchan
                  if (allocated(calmask)) deallocate(calmask)
                  allocate(calmask(i2-i1+1))
                  if (calbychannel) then
                     calmask   &
                       =gains(ifb)%phot(ibd,ipix,i1:i2).ne.blankingraw   &
                       .and.   &
                       gains(ifb)%pcold(ibd,ipix,i1:i2).ne.blankingraw
                     do ichan = i1, i2
                        if (calmask(ichan)) then
                           photsignal   &
                             = gains(ifb)%phot(ibd,ipix,ichan)
                           pcoldsignal   &
                             = gains(ifb)%pcold(ibd,ipix,ichan)
                           gains(ifb)%trx(ibd,ipix,ichan)   &
                             =(photsignal*mon(ifb)%data%thotcold(1,2)   &
                             -pcoldsignal*mon(ifb)%data%thotcold(1,1))   &
                             /(pcoldsignal-photsignal)
                           trec = trec+gains(ifb)%trx(ibd,ipix,ichan)   &
                             /count(calmask)
                        endif
                     enddo
                  else
                     calmask   &
                       =gains(ifb)%phot(ibd,ipix,i1:i2).ne.blankingraw
                     photsignal   &
                       = sum(gains(ifb)%phot(ibd,ipix,i1:i2),calmask)   &
                       /count(calmask)
                     calmask   &
                       =gains(ifb)%pcold(ibd,ipix,i1:i2).ne.blankingraw
                     pcoldsignal   &
                       = sum(gains(ifb)%pcold(ibd,ipix,i1:i2),calmask)   &
                       /count(calmask)
                     gains(ifb)%trx(ibd,ipix,1)   &
                       = (photsignal*mon(ifb)%data%thotcold(1,2)   &
                       -pcoldsignal*mon(ifb)%data%thotcold(1,1))   &
                       /(pcoldsignal-photsignal)
                     trec = trec+gains(ifb)%trx(ibd,ipix,1)
                  endif
               enddo
               trec = trec/nbd
               j = index(febe(ifb)%header%febe,' ')
               tmpbackend = febe(ifb)%header%febe(j+1:j+8)
               write(message,'(T1,A5,T7,A5,T15,i1,T21,f7.2)')   &
                 febe(ifb)%header%febe(1:5), tmpbackend(1:5), ipix,   &
                 trec
               call gagout(message)
            enddo
         enddo
         return
      else if (index(tmpscantype,'CAL').ne.0) then
         do ifb = 1 ,nfb
            nbd = febe(ifb)%header%febeband
            npix = febe(ifb)%header%febefeed
            do ipix = 1, npix
               do ibd = 1, nbd
                  nchan = array(ifb)%header(ibd)%usedchan
                  i1 = array(ifb)%header(ibd)%dropchan+1
                  i2 = array(ifb)%header(ibd)%dropchan   &
                      +array(ifb)%header(ibd)%usedchan
                  if (allocated(calmask)) deallocate(calmask)
                  allocate(calmask(i2-i1+1))
                  if (calbychannel) then
                     calmask   &
                       =gains(ifb)%phot(ibd,ipix,i1:i2).ne.blankingraw   &
                       .and.   &
                       gains(ifb)%pcold(ibd,ipix,i1:i2).ne.blankingraw
                     do ichan =  i1, i2
                        if (calmask(ichan)) then
                           photsignal   &
                             = gains(ifb)%phot(ibd,ipix,ichan)
                           pcoldsignal   &
                             = gains(ifb)%pcold(ibd,ipix,ichan)
                           gains(ifb)%trx(ibd,ipix,ichan)   &
                             = (photsignal*mon(ifb)%data%thotcold(1,2)   &
                             -pcoldsignal*mon(ifb)%data%thotcold(1,1))   &
                             /(pcoldsignal-photsignal)
                        else
                           gains(ifb)%trx(ibd,ipix,ichan) = -1.
                        endif
                     enddo
                  else
                     calmask   &
                       = gains(ifb)%phot(ibd,ipix,i1:i2).ne.blankingraw
                     photsignal   &
                       = sum(gains(ifb)%phot(ibd,ipix,i1:i2),calmask)   &
                       /count(calmask)
                     calmask   &
                       =gains(ifb)%pcold(ibd,ipix,i1:i2).ne.blankingraw
                     pcoldsignal   &
                       = sum(gains(ifb)%pcold(ibd,ipix,i1:i2),calmask)   &
                       /count(calmask)
                     gains(ifb)%trx(ibd,ipix,1)   &
                       = (photsignal*mon(ifb)%data%thotcold(1,2)   &
                       -pcoldsignal*mon(ifb)%data%thotcold(1,1))   &
                       /(pcoldsignal-photsignal)
                  endif
                  if (index(tmpswitchmode,'FREQ').ne.0) then
                     calmask = gains(ifb+nfb)%phot(ibd,ipix,i1:i2)   &
                       .ne.blankingraw
                     photsignal = sum(   &
                       gains(ifb+nfb)%phot(ibd,ipix,i1:i2),calmask   &
                       )/count(calmask)
                     calmask = gains(ifb+nfb)%pcold(ibd,ipix,i1:i2)   &
                       .ne.blankingraw
                     pcoldsignal = sum(   &
                       gains(ifb+nfb)%pcold(ibd,ipix,i1:i2),calmask   &
                       )/count(calmask)
                     gains(ifb+nfb)%trx(ibd,ipix,1)   &
                       = (photsignal*mon(ifb)%data%thotcold(1,2)   &
                       -pcoldsignal*mon(ifb)%data%thotcold(1,1))   &
                       /(pcoldsignal-photsignal)
                  endif
               enddo
            enddo
         enddo
      endif
   endif
   !
   if (index(tmpscantype,'CAL').ne.0.and.tmpscantype.ne.'CALIBIMAGE'   &
     .and.lastifb.eq.nfb.and.allocated(igains)) then
      do ifb = 1, nfb
         do jfb = 1, size(igains)
            if (gains(ifb)%febe.eq.igains(jfb)%febe)   &
              gains(ifb)%gainimage = igains(jfb)%gainimage
         enddo
      enddo
   endif
   !
   if (.not.associated(zfocus%sol(1)%x)) then
      do i = firstifb, lastifb
         reduce(i)%focus_done = .false.
      enddo
   else
      do i = firstifb, lastifb
         reduce(i)%focus_done = .true.
      enddo
   endif
   !
   if (.not.associated(pcross(1)%sol%x)) then
      do i = firstifb, lastifb
         reduce(i)%pointing_done = .false.
      enddo
   else
      do i = firstifb, lastifb
         reduce(i)%pointing_done = .true.
      enddo
   endif
   !
   if (index(tmpscantype,'POINT').ne.0) then
      do i = firstifb, lastifb
         reduce(i)%pointing_done = .false.
      enddo
   else if (index(tmpscantype,'FOCUS').ne.0) then
      do i = firstifb, lastifb
         reduce(i)%focus_done = .false.
      enddo
   endif
   !
   do i = firstifb, lastifb
      reduce(i)%calibration_done(1:5) = .false.
      reduce(i)%base_done        = .false.
      reduce(i)%despike_done     = .false.
   enddo
   !
   ! bring polarimetry data into order H,V,R,I
   !
   if (polmode) then
      allocate(febetmp(nfb),arraytmp(nfb),datatmp(nfb),gainstmp(nfb),   &
               antennatmp(nfb),backendtmp(nfb),montmp(nfb),   &
               subreftmp(nfb),reducetmp(nfb),   &
               ifbold(nfb),stat=ier)
      nspec = (lastifb-firstifb+1)/4
      j = 0
      do i = firstifb, lastifb, 4
         i1 = index(febe(i)%header%febe,' ')
         i2 = len_trim(febe(i)%header%febe)
         j = j+1
         febetmp(j)%header%febe = febe(i)%header%febe(i1:i2)
      enddo
      do i = 1, nspec
         do j = 1, 4
            k = (i-1)*4+j
            do ifb = firstifb, lastifb
               if (febe(ifb)%header%febe(1:1).eq.stokes(j).and.   &
                   febe(ifb)%header%febe(i1:i2)   &
                   .eq.febetmp(i)%header%febe   &
                 ) then
                  ifbold(k) = ifb
                  exit
               endif
            enddo
         enddo
      enddo
      datatmp(1:nfb) = data(1:nfb)
      data(1:nfb) = datatmp(ifbold(1:nfb))
      montmp(1:nfb) = mon(1:nfb)
      mon(1:nfb) = montmp(ifbold(1:nfb))
      febetmp(1:nfb) = febe(1:nfb)
      febe(1:nfb) = febetmp(ifbold(1:nfb))
      arraytmp(1:nfb) = array(1:nfb)
      array(1:nfb) = arraytmp(ifbold(1:nfb))
      reducetmp(1:nfb) = reduce(1:nfb)
      reduce(1:nfb) = reducetmp(ifbold(1:nfb))
      do ifb = firstifb, lastifb
         scan%data%febe(ifb) = febe(ifb)%header%febe
      enddo
      if (index(tmpscantype,'GRID').ne.0) then
         gainstmp(1:nfb) = gains(1:nfb)
         gains(1:nfb) = gainstmp(ifbold(1:nfb))
         do i = 1, nspec
            i1 = 4*i
            where (gains(i1-3)%gainarray.ne.blankingraw.and.   &
                   gains(i1-2)%gainarray.ne.blankingraw)
               gains(i1)%gainarray   &
                 = sqrt(gains(i1-3)%gainarray*gains(i1-2)%gainarray)
            elsewhere
               gains(i1)%gainarray = blankingraw
            endwhere
            gains(i1-1)%gainarray = gains(i1)%gainarray
         enddo
      endif
      do i = 1, nsubscan
         antennatmp = raw(i)%antenna(:)
         raw(i)%antenna = antennatmp(ifbold(1:nfb))
         backendtmp = raw(i)%backend(:)
         raw(i)%backend = backendtmp(ifbold(1:nfb))
         subreftmp = raw(i)%subref(:)
         raw(i)%subref = subreftmp(ifbold(1:nfb))
      enddo
      deallocate(febetmp,arraytmp,datatmp,montmp,gainstmp)
      deallocate(antennatmp,backendtmp,subreftmp,reducetmp,   &
                 ifbold,stat=ier)
   endif
   !
   !
   !
10 format(t4,a51)
20 format(t4,a1,t20,i1,t29,a17,t54,a1)
   !
   return
!
end subroutine getfits
!
