subroutine mira_list(line,error)
!
! Called by MIRA subroutine run_mira (source code in mira/lib/run.f90), command LIST,
! and SUBROUTINE FINDMIRA (see source code in find.f90).
! See interactive HELP or user's guide for options.
!
! Input: command line from interactive Mira session
! Output: error flag.
!
   use mira
   use pcross_definitions
   use gkernel_interfaces
   !
   implicit none
   !
   character(len = *)             :: line
   logical                        :: error
   !
   integer                        :: flagFebe, nFlagSubscan
   integer, dimension(16)         :: flagSubscan
   integer                        :: i,iday, ier, ih, im, imon, it,    &
                                     iyear, j, j1, j2, k, k1, k2, l,   &
                                     lc, lun, nbd, nchan, npix, nxchan
   real*8                         :: freq, jd, sec, utc, tau, tsys,    &
                                     tsys1, tsys2, trec, trec1, trec2, &
                                     pwv, fluxCorr
   logical                        :: ex,polmode,doflux,    &
                                     doflag,doproject,doreduce,newscan
   logical, dimension(:,:,:), allocatable :: calmask
   character(len=5)               :: receiver
   character(len=4), parameter    :: stokes = 'HVRI'
   character(len=8)               :: backend,tmpbackend, tmpfrontend, tmpproc
   character(len=12)              :: date
   character(len=14)              :: format
   character(len=23)              :: tmpdate, tmpdate0
   character(len=30)              :: user
   character(len=80)              :: backendList, command, output
   character(len=256)             :: ch, file, string
   character(len=3),dimension(12) :: month = (/'jan','feb','mar',   &
                                               'apr','may','jun',   &
                                               'jul','aug','sep',   &
                                               'oct','nov','dec'/)
   !
   integer, dimension(:), allocatable :: indx, part
   !
   if (.not.associated(list)) then
      call gagout('E-LIST, current index list is empty.')
      error = .true.
      return
   endif
   !
   doproject = sic_present(3,0)
   doreduce  = sic_present(4,0)
   doflux    = sic_present(5,0)
   format    = 'shortByScan'
   !
   if (doflux.and.sic_present(6,1)) then
      call sic_ch(line,6,1,format,lc,.false.,error)
      call sic_upper(format)
      if (index(format,'SHORT').eq.0.and.index(format,'LONG').eq.0   &
        .and.index(format,'SCAN').eq.0.and.index(format,'SUB')   &
        .eq.0) then
         call gagout('W-LIST: invalid output format, reset to '//   &
           'shortByScan')
         format = 'SHORTBYSCAN'
      else if (index(format,'LONG').ne.0) then
         call gagout('W-LIST: long output format not yet'//   &
                     ' supported, reset to shortByScan')
         format = 'SHORTBYSCAN'
      endif
   endif
   ! 
   doflag =  doflux.and.sic_present(7,0).and.sic_present(7,1).and.sic_present(7,2)
   if (sic_present(7,0).and.(.not.sic_present(7,1).or..not.sic_present(7,2))) then
      call gagout('W-LIST: please specify a frontend/backend unit and a subscan to be flagged.')
   else if (doflag) then
      call sic_i4(line,7,1,flagFeBe,.true.,error)
      if (error) then
         call gagout('E-LIST: invalid input.')
         return
      endif
      nFlagSubscan = sic_narg(7)-1
      if (nFlagSubscan.eq.0) then
         call gagout('E-LIST: invalid input.')
         error=.true.
         return
      endif
      do i = 1, nFlagSubscan
         call sic_i4(line,7,i+1,flagSubscan(i),.true.,error)
      enddo
   endif
   !
   if (size(list).eq.0) then
      call gagout('I-LIST: index list is empty.')
      error = .true.
      return
   endif
   !
   if (sic_present(1,1)) then
      call sic_ch(line,1,1,output,lc,.false.,error)
      ier = sic_getlun(lun)
      if (index(output,'.')==0) output = trim(output)//'.lis'
      open(lun,file=output,form='formatted',status='unknown')
      !
      do i = 1, size(list)
         if (sic_present(2,0)) then
            !
            if (allocated(part)) deallocate(part,stat=ier)
            allocate(part(list(i)%ncfe),stat=ier)
            if (allocated(indx)) deallocate(indx,stat=ier)
            allocate(indx(list(i)%ncfe),stat=ier)
            do j = 1, list(i)%ncfe
               tmpbackend = adjustl(list(i)%backend(j))
               k1 = index(tmpbackend,'/')+1
               if (k1.eq.1) then
                  part(j) = j
               else
                  k2 = len_trim(tmpbackend)
                  read(tmpbackend(k1:k2),'(i3)') part(j)
               endif
               tmpfrontend = list(i)%frontend(j)
               call sic_upper(tmpfrontend)
               if (index(tmpfrontend,'I').eq.ipc) polmode = .true.
            enddo
            if (polmode) then
               part = 10*part(:)
               do j = 1, list(i)%ncfe
                  tmpfrontend = list(i)%frontend(j)
                  call sic_upper(tmpfrontend)
                  part(j) = part(j)+index(stokes,tmpfrontend(ipc:ipc))
               enddo
            endif
            call indexx(list(i)%ncfe,dble(part),indx)
            !
            k = indx(1)
            it = index(list(i)%dateobs,'T')
            tmpdate = list(i)%dateobs
            write(lun,100) list(i)%scan,   &
                           adjustl(list(i)%object),   &
                           adjustl(list(i)%transition(k)),   &
                           adjustl(list(i)%procedure),   &
                           adjustl(list(i)%switchmode),   &
                           adjustl(list(i)%frontend(k)),   &
                           adjustl(list(i)%backend(k)),   &
                           tmpdate(it-10:it-1),   &
                           i
            do j = 2, list(i)%ncfe
               k = indx(j)
               write(lun,200)   &
                 adjustl(list(i)%transition(k)),   &
                 adjustl(list(i)%frontend(k)),   &
                 adjustl(list(i)%backend(k))
            enddo
         else
            j = index(list(i)%backend(1),'/')
            tmpbackend = adjustl(list(i)%backend(1))
            it = index(list(i)%dateobs,'T')
            tmpdate = list(i)%dateobs
            if (j.eq.0) j = len_trim(tmpbackend)+1
            if (doproject) then
               write(lun,301) list(i)%scan,   &
                              adjustl(list(i)%object),   &
                              adjustl(list(i)%procedure),   &
                              adjustl(list(i)%switchmode),   &
                              tmpbackend(1:j-1),   &
                              tmpdate(it-10:it-1),   &
                              list(i)%project,   &
                              i
            else
               write(lun,300) list(i)%scan,   &
                              adjustl(list(i)%object),   &
                              adjustl(list(i)%procedure),   &
                              adjustl(list(i)%switchmode),   &
                              tmpbackend(1:j-1),   &
                              tmpdate(it-10:it-1),   &
                              i
            endif
         endif
      enddo
      close(lun)
      ier = gag_frelun(lun)
   else if (doreduce) then
      if (sic_present(4,1)) then
         call sic_ch(line,4,1,output,lc,.false.,error)
         ier = sic_getlun(lun)
         if (index(output,'.')==0) output = trim(output)//'.mira'
      else
         ier = sic_getlun(lun)
         output = 'reduce.mira'
      endif
      open(lun,file=output,form='formatted',status='unknown')
      file = 'INPUT_FILE:'
      call sic_parsef(file,ch,' ',' ')
      write(lun,*) 'ON ERROR PAUSE'
      write(lun,*) 'FILE IN "'//trim(ch)//'"'
      if (sic_present(4,2)) then
         call sic_ch(line,4,2,output,lc,.false.,error)
         inquire(file=output,exist=ex)
         if (index(output,'.')==0) output = trim(output)//'.30m'
         if (ex) then
            string = 'FILE OUT '//trim(output)
         else
            string = 'FILE OUT '//trim(output)//' NEW'
         endif
      else
         inquire(file='mira.30m',exist=ex)
         if (ex) then
            string = 'FILE OUT mira.30m'
         else
            string = 'FILE OUT mira.30m NEW'
         endif
      endif
      write(lun,*) trim(string)
      write(lun,*)'!---------------------------------------'//   &
                   '---------------------------------------'
      if (allocated(choice%backend).and.size(choice%backend).ne.0) then
         backendList = " /BACKEND"
         do j = 1, size(choice%backend)
            backendList = trim(backendList)//" "//choice%backend(j)
         enddo
      else
         backendList = ""
      endif
      do i = 1, size(list)
         newscan = .false.
         if (i.gt.1) then
            tmpdate0 = list(i-1)%dateobs
            tmpdate = list(i)%dateobs
            it = index(tmpdate,'T')
         endif
         if (i.eq.1) then
            write(lun,*) 'FIND /OBSERVED '//list(i)%dateobs(1:10)//backendList
            write(lun,*)'!---------------------------------------'//   &
                         '---------------------------------------'
            newscan = .true.
         else if (tmpdate0(it-10:it-1).ne.tmpdate(it-10:it-1)) then
            write(lun,*)'!---------------------------------------'//   &
                         '---------------------------------------'
            write(lun,*) 'FIND /OBSERVED '//tmpdate(it-10:it-1)//backendList
            write(lun,*)'!---------------------------------------'//   &
                         '---------------------------------------'
            newscan = .true.
         else if (list(i-1)%scan.ne.list(i)%scan) then
            newscan = .true.
         endif
         if (newscan) then
            write(string,'(A5,I0)') 'SCAN ',list(i)%scan
            write(string(20:30),'(A11)') ' ! '//list(i)%procedure
            write(string(31:39),'(A9)')  '   '//list(i)%project
            write(lun,*) trim(string)
            tmpproc = adjustl(list(i)%procedure)
            call sic_upper(tmpproc)
            if (.not.sic_present(2,0)) then
               polmode = .false.
               do k = 1, list(i)%ncfe
                  tmpfrontend = list(i)%frontend(k)
                  call sic_upper(tmpfrontend)
                  if (index(tmpfrontend,"I").eq.ipc) then
                     polmode = .true.
                     exit
                  endif
               enddo
            endif
            if ((index(tmpproc,'CAL').eq.0.and.index(tmpproc,'FOC').eq.0.)   &
                .or.(index(tmpproc,'CAL').ne.0.and.polmode)) then
               write(lun,*) 'CAL all'
               write(lun,*) 'WRITE /FEBE all /PIXEL all'
            endif
         endif
      enddo
      close(lun)
      ier = gag_frelun(lun)

   else if (doflux) then

      command = trim(line)
      call sic_get_logi('doPause',dopause,error)
      ier = sic_getlun(lun)
      read(list(1)%dateobs(1:4),'(I4)')    iyear
      read(list(1)%dateobs(6:7),'(I2.2)')  imon
      read(list(1)%dateobs(9:10),'(I2.2)') iday
      read(list(1)%dateobs(12:13),'(I2.2)') ih
      read(list(1)%dateobs(15:16),'(I2.2)') im
      read(list(1)%dateobs(18:23),'(F6.3)') sec
      if (.not.sic_present(5,1)) then
         write(output(1:21),'(A21)') 'point_'//list(1)%dateobs(9:10)//   &
                                     '-'//month(imon)//   &
                                     '-'//list(1)%dateobs(1:4)//'.dat'
         open(lun,file=output,status='unknown')
      else
         call sic_ch(line,5,1,backend,lc,.false.,error)
         call sic_lower(backend)
         if (index(backend(1:2),'1m').ne.0) then
            write(output(1:19),'(A19)') '1mhz-'//list(1)%dateobs(1:4)//'-' &
                                               //list(1)%dateobs(6:7)//'-' &
                                               //list(1)%dateobs(9:10)     &
                                               //'.dat'
            open(lun,file=output,status='unknown')
            call sic_date(date)
            call sic_lower(date)
            write(lun,'(A1)')  '!'
            write(lun,'(A11,A19)') '! $Header: ', output(1:19)
            call sic_user(user)
            write(lun,'(A60)') '! Written on '//date//' by: '//user
            write(lun,'(A12)') '! MIRA '//miraVersion
         else if (index(backend(1:2),'4m').ne.0) then
            write(output(1:19),'(A19)') '4mhz-'//list(1)%dateobs(1:4)//'-'  &
                                               //list(1)%dateobs(6:7)//'-'  &
                                               //list(1)%dateobs(9:10)//'-' &
                                               //'.dat'
            open(lun,file=output,status='unknown')
            call sic_date(date)
            call sic_lower(date)
            write(lun,'(A1)')  '!'
            write(lun,'(A11,A19)') '! $Header: ', output(1:19)
            call sic_user(user)
            write(lun,'(A70)') '! Written on '//date//' by: '//user
            write(lun,'(A12)') '! MIRA '//miraVersion
         else if (index(backend(1:2),'ve').ne.0) then
            write(output(1:20),'(A20)') 'vespa-'//list(1)%dateobs(1:4)//'-' &
                                                //list(1)%dateobs(6:7)//'-' &
                                                //list(1)%dateobs(9:10)     &
                                                //'.dat'
            open(lun,file=output,status='unknown')
            call sic_date(date)
            call sic_lower(date)
            write(lun,'(A1)')  '!'
            write(lun,'(A11,A20)') '! $Header: ', output(1:20)
            call sic_user(user)
            write(lun,'(A60)') '! Written on '//date//' by: '//user
            write(lun,'(A12)') '! MIRA '//miraVersion
         else if (index(backend(1:2),'wi').ne.0) then
            write(output(1:20),'(A20)') 'wilma-'//list(1)%dateobs(1:4)//'-' &
                                                //list(1)%dateobs(6:7)//'-' &
                                                //list(1)%dateobs(9:10)     &
                                                //'.dat'
            open(lun,file=output,status='unknown')
            call sic_date(date)
            call sic_lower(date)
            write(lun,'(A1)')  '!'
            write(lun,'(A11,A20)') '! $Header: ', output(1:20)
            call sic_user(user)
            write(lun,'(A60)') '! Written on '//date//' by: '//user
            write(lun,'(A12)') '! MIRA '//miraVersion
         endif
      endif

      if (.not.sic_present(5,1)) then
         write(lun,'(A1)')  '!'
         write(lun,400)     '!', 'YYYY', 'MM', 'DD', 'UT[h]',   &
                            'JD -0.5 days', 'Scan', 'Frequ.', 'Elv.',   &
                            'Area', '+/-', 'Pos.', '+/-', 'Width',   &
                            '+/-', 'Peak', '+/-', 'Date', 'Dir.',   &
                            'Source','Receiver','LST','Azm.','parAngle',   &
                            'tau','Tsys','Trec','Tamb','pAmb','R.H.','corr','quality'
         write(lun,401)     '!', '____', '__', '__', '_____',   &
                            '____________', '____', '_______','____',   &
                            '______________','____________',   &
                            '___________','____________',   &
                            '_____________','______','__________',   &
                            '________','________','_____','________',   &
                            '____','_____','_____','____','____','____','_____','_______'
         write(lun,'(A1)') '!'
      else
         write(lun,'(A1)')  '!'
         write(lun,500)     '!', 'YYYY', 'MM', 'DD', 'UT[h]',           &
                            'JD -0.5 days', 'Scan', 'Frequ.', 'Elv.',   &
                            'Flux [K]', '+/-', 'Date', 'Source',        &
                            'Fend/Bend', 'LST','Azm.','parAngle', 'tau', &
                            'Tsys', 'Trec','Tamb','pAmb','R.H.','pwv',  &
                            'tInt[s]','nsub','quality'                
         write(lun,'(A204)') '!_____________________________'//         &
                             '______________________________'//         &
                             '______________________________'//         &
                             '______________________________'//         &
                             '______________________________'//         &
                             '______________________________'//         &
                             '________________________'
         write(lun,'(A1)')   '!'
      endif


      do i = 1, size(list)
         write(string,'(A5,I4)') 'scan ',list(i)%scan
         call exec_program(string)
         tmpproc = list(i)%procedure
         call sic_upper(tmpproc)
         if (index(tmpproc,'POINT').ne.0.and.doflux.and.doflag) then
            write(string,'(A5,I2,A10)') 'flag ',flagFebe,' /subscan '
            do l = 1, nFlagSubscan
               j1 = 19+(l-1)*3
               j2 = j1+1
               write(string(j1:j2),'(I2)') flagSubscan(l) 
            enddo
            call exec_program(string)
         endif
         tmpBackend = adjustl(list(i)%backend(1))
         call sic_lower(tmpBackend)
         if (index(scan%header%scantype,'calibGrid').ne.0.and.     &
             tmpBackend(1:2).eq.backend(1:2)) then
            write(string,'(A7)') 'cal all'
            call exec_program(string)
         endif
         if (index(tmpproc,'ONOFF').ne.0.and.tmpBackend(1:2).eq.backend(1:2)) &
         then
            write(string,'(A7)') 'cal all'
            call exec_program(string)
            if (i.gt.1) then
               if (list(i-1)%scan.eq.list(i)%scan) then
                  j1 = j2+1
                  j2 = j1+list(i)%ncfe
               else
                  j1 = 1 
                  j2 = list(1)%ncfe
               endif
            else
               j1 = 1 
               j2 = list(1)%ncfe
            endif
            do j = j1, j2 
               nbd = febe(j)%header%febeband
               nxchan = size(gains(j)%tauzen,3)
               npix = febe(j)%header%febefeed
               allocate(calmask(nbd,npix,nxchan),stat=ier)
               calmask = gains(j)%tsys.ne.-1.
               freq = nint(array(j)%header(1)%restfreq*1.d-6)/1000.
               tau  = sum(gains(j)%tauzen,calmask)/count(calmask)
               tau  = nint(100*tau)/100.
               pwv  = sum(gains(j)%h2omm,calmask)/count(calmask)
               pwv  = nint(100*pwv)/100.
               if (index(backend,'ve').ne.0.and.j.gt.j1+1) then
                  calmask = gains(j1)%tsys.ne.-1.
                  tsys1 = sum(gains(j1)%tsys,calmask)/count(calmask)
                  trec1 = sum(gains(j1)%trx,calmask)/count(calmask)
                  calmask = gains(j1+1)%tsys.ne.-1.
                  tsys2 = sum(gains(j1+1)%tsys,calmask)/count(calmask)
                  trec2 = sum(gains(j1+1)%trx,calmask)/count(calmask)
                  tsys = nint(10*sqrt(tsys1*tsys2))/10.
                  trec = nint(10*sqrt(trec1*trec2))/10.
                  fluxCorr = sum(gains(j1+1)%phasearray)     &                          
                             /size(gains(j1+1)%phasearray)
               else
                  calmask = gains(j)%tsys.ne.-1.
                  tsys = sum(gains(j)%tsys,calmask)/count(calmask) 
                  tsys = nint(10*tsys)/10.
                  trec = sum(gains(j)%trx,calmask)/count(calmask) 
                  trec = nint(10*trec)/10.
                  fluxCorr = 1.0
               endif
               deallocate(calmask)
               nchan = data(j)%header%channels
               call fluxBackend(lun,freq,iyear,imon,iday,month(imon),   &
                                j,nbd,nchan,tau,pwv,tsys,trec,fluxCorr)
               if (dopause) then
                  call gagout('type c to continue, q to quit')
                  read(*,*) string
                  call sic_upper(string)
                  if (string(1:1).eq.'Q') then
                     close(lun)
                     ier = gag_frelun(lun)
                     call sic_insert(command)
                     return
                  endif
               endif
            enddo
            write(lun,'(A1)') '!'
         else if (index(tmpproc,'POINT').ne.0.) then
            write(string,'(A7)') 'cal all'
            call exec_program(string)
            do j = 1, list(i)%ncfe
               freq = nint(array(j)%header(1)%restfreq*1.d-6)/1000.
               tau  = nint(100*gains(j)%tauzen(1,1,1))/100.
               tsys = nint(10*gains(j)%tsys(1,1,1))/10.
               trec = nint(10*gains(j)%trx(1,1,1))/10.
               receiver = scan%data%febe(j)
               write(string,'(A6,I2)') 'solve ',j
               call exec_program(string)
               call fluxfill(lun,freq,iyear,imon,iday,month(imon),format,receiver, &
                             tau,tsys,trec,j,doflag,flagFebe,flagSubscan,nFlagSubscan)
               if (dopause) then
                  call gagout('type c to continue, q to quit')
                  read(*,*) string
                  call sic_upper(string)
                  if (string(1:1).eq.'Q') then
                     close(lun)
                     ier = gag_frelun(lun)
                     call sic_insert(command)
                     return
                  endif
               endif
            enddo
            write(lun,'(A1)') '!'
         endif
      enddo
      close(lun)
      ier = gag_frelun(lun)
      call sic_insert(command)
   else
      do i = 1, size(list)
         if (sic_present(2,0)) then
            !
            if (allocated(part)) deallocate(part,stat=ier)
            allocate(part(list(i)%ncfe),stat=ier)
            if (allocated(indx)) deallocate(indx,stat=ier)
            allocate(indx(list(i)%ncfe),stat=ier)
            polmode = .false.
            do j = 1, list(i)%ncfe
               tmpbackend = adjustl(list(i)%backend(j))
               k1 = index(tmpbackend,'/')+1
               if (k1.eq.1) then
                  part(j) = j
               else
                  k2 = len_trim(tmpbackend)
                  read(tmpbackend(k1:k2),'(i3)') part(j)
               endif
               tmpfrontend = list(i)%frontend(j)
               call sic_upper(tmpfrontend)
               if (index(tmpfrontend,'I').eq.ipc) polmode = .true.
            enddo
            if (polmode) then
               part = 10*part(:)
               do j = 1, list(i)%ncfe
                  tmpfrontend = list(i)%frontend(j)
                  call sic_upper(tmpfrontend)
                  part(j) = part(j)+index(stokes,tmpfrontend(ipc:ipc))
               enddo
            endif
            call indexx(list(i)%ncfe,dble(part),indx)
            !
            k = indx(1)
            it = index(list(i)%dateobs,'T')
            tmpdate = list(i)%dateobs
            write(*,100) list(i)%scan,   &
                         adjustl(list(i)%object),   &
                         adjustl(list(i)%transition(k)),   &
                         adjustl(list(i)%procedure),   &
                         adjustl(list(i)%switchmode),   &
                         adjustl(list(i)%frontend(k)),   &
                         adjustl(list(i)%backend(k)),   &
                         tmpdate(it-10:it-1),   &
                         i
            do j = 2, list(i)%ncfe
               k = indx(j)
               write(*,200)   &
                 adjustl(list(i)%transition(k)),   &
                 adjustl(list(i)%frontend(k)),   &
                 adjustl(list(i)%backend(k))
            enddo
         else
            tmpbackend = adjustl(list(i)%backend(1))
            k = index(tmpbackend,'/')
            if (k.eq.0) k = len_trim(tmpbackend)+1
            it = index(list(i)%dateobs,'T')
            tmpdate = list(i)%dateobs
            if (doproject) then
               write(*,301) list(i)%scan,   &
                            adjustl(list(i)%object),   &
                            adjustl(list(i)%procedure),   &
                            adjustl(list(i)%switchmode),   &
                            tmpbackend(1:k-1),   &
                            tmpdate(it-10:it-1),   &
                            list(i)%project,   &
                            i
            else
               write(*,300) list(i)%scan,   &
                            adjustl(list(i)%object),   &
                            adjustl(list(i)%procedure),   &
                            adjustl(list(i)%switchmode),   &
                            tmpbackend(1:k-1),   &
                            tmpdate(it-10:it-1),   &
                            i
            endif
         endif
      enddo
   endif
   !
100 format(t1,i4,t6,a10,t17,a10,t27,a8,t36,a14,   &
           t51,a5,t57,a8,t66,a10,t76,i4)
200 format(t17,a10,t51,a5,t57,a8)
300 format(t1,i4,t6,a10,t17,a8,t31,a16,t50,a5,t58,a10,t70,i4)
301 format(t1,i4,t6,a10,t17,a8,t31,a16,t50,a5,t58,a10,t70,a6,t77,i4)
400 format(t1,a1,t5,a4,t10,a2,t13,a2,t16,a5,t22,a12,t37,a4,t43,a6,t52,     &
           a4,t60,a5,t69,a3,t75,a4,t83,a3,t90,a5,t97,a3,t104,a4,t111,      &
           a3,t118,a4,t133,a4,t141,a6,t152,a8,t161,a3,t171,a4,t177,        &
           a8,t186,a3,t191,a4,t197,a4,t203,a4,t208,a4,t213,a4,t218,a4,t224,a7)
401 format(t1,a1,t5,a4,t10,a2,t13,a2,t16,a5,t22,a12,t37,a4,t43,a7,t52,     &
           a4,t60,a14,t76,a12,t90,a11,t104,a12,t118,a13,t133,a6,t141,      &
           a10,t152,a8,t161,a8,t171,a5,t177,a8,t186,a4,t191,a5,t197,       &
           a5,t203,a4,t208,a4,t213,a4,t218,a4,t224,a7)
500 format(t1,a1,t5,a4,t10,a2,t13,a2,t16,a5,t22,a12,t37,a4,t43,a6,t52,a4,  &
           t60,a8,t76,a3,t88,a4,t102,a6,t113,a9,t123,a3,t132,a4,t138,      &
           a8,t147,a3,t152,a4,t159,a4,t165,a4,t170,a4,t176,a4,t181,a3,     &
           t185,a7,t193,a4,t198,a7)
   !
   return
!
end subroutine mira_list
!
!
!
subroutine fluxfill(lun,freq,iyear,imon,iday,month,   &
     format,receiver,tau,tsys,trec,ifb,doflag,flagFebe,flagSubscan,nFlagSubscan)
!
! Called by mira_list. Creates an output ASCII file with flux densities from
! monitoring sessions.
!
   use mira
   use pcross_definitions
   implicit none
   integer            :: ifb, iyear, imon, iday, lsth, lstm, lsts,   &
                         lun, flagFebe, nFlagSubscan
   integer, dimension(16) :: flagSubscan
   real*8             :: freq, tau, tsys, trec
   character(len=  3) :: month
   character(len=  5) :: receiver
   character(len=  6) :: dir
   character(len= 10) :: source
   character(len= 13) :: date
   character(len= 14) :: format
   integer            :: ipix, iqual, k, l
   real*8             :: area, azm, corr, diff, earea, epeak, epos, ewidth,  &
                         elv, jd, pamb, parangle, peak, pos, rh, tamb,       &
                         utc, width
   logical            :: doflag, error, flagit
   date(1:1) = "'"
   date(13:13) = "'"
   date(4:4) = "-"
   date(8:8) = "-"
   write(date(2:3),'(I2)') iday
   write(date(5:7),'(A3)') month
   write(date(9:12),'(I4)') iyear
   dir(1:5) = "'AZI'"
   source = "'"//scan%header%object(1:8)//"'"
   tamb = nint(mon(1)%data%tamb_p_humid(1,1)+273.15)
   pamb = nint(mon(1)%data%tamb_p_humid(1,2))
   rh   = nint(mon(1)%data%tamb_p_humid(1,3))
   if (index(format,'SUB').ne.0) then
      do k = 1, scan%header%nobs
         if (index(pcross(k)%dir,'+LAM').ne.0) then
            dir = "'"//"AZI+"
         else if (index(pcross(k)%dir,'-LAM').ne.0) then
            dir = "'"//"AZI-"
         else if (index(pcross(k)%dir,'+BET').ne.0) then
            dir = "'"//"ELV+"
         else if (index(pcross(k)%dir,'-BET').ne.0) then
            dir = "'"//"ELV-"
         endif
         do l = 1, size(data(1)%data%subscan)
            if (data(1)%data%subscan(l).eq.k) then
               lsth = int(data(1)%data%lst(l)/3600.)
               lstm = int((data(1)%data%lst(l)-3600.*lsth)/60.)
               lsts = nint(data(1)%data%lst(l)-3600.*lsth-60.*lstm)
               exit
            endif
         enddo
         do l = 1, size(mon(1)%data%subscan)
            if (mon(1)%data%subscan(l).eq.k) then
               azm = nint(mon(1)%data%encoder_az_el(l,1)*10.)/10.
               elv = nint(mon(1)%data%encoder_az_el(l,2)*10.)/10.
               parangle = nint(mon(1)%data%parangle(l)*10.)/10.
               exit
            endif
         enddo
         utc = raw(k)%antenna(1)%subscanstart
         utc = nint((utc-int(utc))*2400)/100.
         jd=nint(raw(k)%antenna(1)%subscanstart*1.d4)/1.d4+2.4d6
         area   = pcross(k)%fun%par(1)%value
         pos    = pcross(k)%fun%par(2)%value
         if (index(dir,'AZI').ne.0) then
            corr  = nint((mon(ifb)%header%iaobs_caobs_ieobs(2)*3.6d+3   &
                    +pcross(k)%fun%par(2)%value)*10)/10.
         else if (index(dir,'ELV').ne.0) then
            corr  = nint((mon(ifb)%header%iaobs_caobs_ieobs(3)*3.6d+3   &
                    +pcross(k)%fun%par(2)%value)*10)/10.
         endif
         width  = pcross(k)%fun%par(3)%value
         earea  = pcross(k)%fun%par(1)%error
         epos   = pcross(k)%fun%par(2)%error
         ewidth = pcross(k)%fun%par(3)%error
         peak = area/width/sqrt(pi/(4.*log(2.d0)))
         epeak = 1./(width*width*sqrt(pi/(4.*log(2.d0))))   &
                 *sqrt((width*earea)**2+(area*ewidth)**2)
         area   = nint(100.*area)/100.
         pos    = nint(100.*pos)/100.
         width  = nint(100.*width)/100.
         peak   = nint(1000.*peak)/1000.
         earea  = nint(100.*earea)/100.
         epos   = nint(100.*epos)/100.
         ewidth = nint(100.*ewidth)/100.
         epeak  = nint(1000.*epeak)/1000.
         flagit = .false.
         if (doflag.and.flagFebe.eq.ifb) then
            do l = 1, scan%header%nobs
               if (k.eq.flagSubscan(l)) flagit = .true.
            enddo
         endif
         if (doflag.and.flagFebe.eq.ifb.and.flagit) then
            peak = -1000.
            area  = -1000.
            write(lun,99) '!', iyear, imon, iday , utc, jd,   &
                           scan%header%scannum, freq, elv, area, earea,   &
                           pos, epos, width, ewidth, peak, epeak, date,   &
                           dir, source, receiver, lsth, ":", lstm, ":",   &
                           lsts, azm, parangle, tau, tsys, trec, tamb,   &
                           pamb, rh, corr
         else
            write(lun,100) iyear, imon, iday , utc, jd,   &
                           scan%header%scannum, freq, elv, area, earea,   &
                           pos, epos, width, ewidth, peak, epeak, date,   &
                           dir, source, receiver, lsth, ":", lstm, ":",   &
                           lsts, azm, parangle, tau, tsys, trec, tamb,   &
                           pamb, rh, corr
         endif
      enddo
   else
      azm = nint(mon(1)%data%encoder_az_el(1,1)*10.)/10.
      elv = nint(mon(1)%data%encoder_az_el(1,2)*10.)/10.
      parangle = nint(mon(1)%data%parangle(1)*10.)/10.
      lsth = int(data(1)%data%lst(1)/3600.)
      lstm = int((data(1)%data%lst(1)-3600.*lsth)/60.)
      lsts = nint(data(1)%data%lst(1)-3600.*lsth-60.*lstm)
      utc = raw(1)%antenna(1)%subscanstart
      utc = nint((utc-int(utc))*2400)/100.
      jd = nint(raw(1)%antenna(1)%subscanstart*1.d4)/1.d4+2.4d6
      call sic_get_dble('PNT%AZM%FIT%AREA',area,error)
      call sic_get_dble('PNT%AZM%FIT%POSITION',pos,error)
      call sic_get_dble('PNT%AZM%FIT%WIDTH',width,error)
      call sic_get_dble('PNT%AZM%ERROR%AREA',earea,error)
      call sic_get_dble('PNT%AZM%ERROR%POSITION',epos,error)
      call sic_get_dble('PNT%AZM%ERROR%WIDTH',ewidth,error)
      peak = area/width/sqrt(pi/(4.*log(2.d0)))
      epeak = 1./(width*width*sqrt(pi/(4.*log(2.d0))))   &
              *sqrt((width*earea)**2+(area*ewidth)**2)
      area  = nint(100.*area)/100.
      pos   = nint(100.*pos)/100.
      corr  = nint((mon(ifb)%header%iaobs_caobs_ieobs(2)*3.6d+3+pos)*10)/10.
      width = nint(100.*width)/100.
      peak  = nint(1000.*peak)/1000.
      earea  = nint(100.*earea)/100.
      epos   = nint(100.*epos)/100.
      ewidth = nint(100.*ewidth)/100.
      epeak  = nint(1000.*epeak)/1000.
!
      if (index(receiver,'HERA').ne.0) then
         ipix = 5
         call gagout('W-LIST, defaults to central pixel.')
      else
         ipix = 1
      endif
!
      iqual = 0
      diff = 0.
      l = 0
      do k = 2, scan%header%nobs
         if (index(pcross(k-1)%dir,'LAM').ne.0                     &
             .and.index(pcross(k)%dir,'LAM').ne.0.                 &
             .and.pcross(k-1)%dir.ne.pcross(k)%dir) then
             l = l+1
             diff = diff+abs(pcross(k)%fun%par(2)%value            &
                             -pcross(k-1)%fun%par(2)%value)        &
                         /(febe(ifb)%data%hpbw(ipix,1)*3.6d+3)
         endif
      enddo
      diff = diff/l
      if (diff.gt.0.1) iqual = 1
!
      write(lun,101) iyear, imon, iday , utc, jd,   &
                     scan%header%scannum, freq, elv, area, earea,   &
                     pos, epos, width, ewidth, peak, epeak, date,   &
                     dir, source, receiver, lsth, ":", lstm, ":",   &
                     lsts, azm, parangle, tau, tsys, trec, tamb,   &
                     pamb, rh, corr, iqual
      call sic_get_dble('PNT%ELV%FIT%AREA',area,error)
      call sic_get_dble('PNT%ELV%FIT%POSITION',pos,error)
      call sic_get_dble('PNT%ELV%FIT%WIDTH',width,error)
      call sic_get_dble('PNT%ELV%ERROR%AREA',earea,error)
      call sic_get_dble('PNT%ELV%ERROR%POSITION',epos,error)
      call sic_get_dble('PNT%ELV%ERROR%WIDTH',ewidth,error)
      peak = area/width/sqrt(pi/(4.*log(2.d0)))
      epeak = 1./(width*width*sqrt(pi/(4.*log(2.d0))))   &
              *sqrt((width*earea)**2+(area*ewidth)**2)
      area  = nint(100.*area)/100.
      pos   = nint(100.*pos)/100.
      corr  = nint((mon(ifb)%header%iaobs_caobs_ieobs(3)*3.6d+3+pos)*10)/10.
      width = nint(100.*width)/100.
      peak   = nint(1000.*peak)/1000.
      earea  = nint(100.*earea)/100.
      epos   = nint(100.*epos)/100.
      ewidth = nint(100.*ewidth)/100.
      epeak  = nint(1000.*epeak)/1000.
!
      iqual = 0
      diff = 0.
      l = 0
      do k = 2, scan%header%nobs
         if (index(pcross(k-1)%dir,'BET').ne.0                            &
             .and.index(pcross(k)%dir,'BET').ne.0.   &
             .and.pcross(k-1)%dir.ne.pcross(k)%dir) then
             l = l+1
             diff = diff+abs(pcross(k)%fun%par(2)%value                   &
                             -pcross(k-1)%fun%par(2)%value)               &
                         /(febe(ifb)%data%hpbw(ipix,1)*3.6d+3)
         endif
      enddo
      diff = diff/l
      if (diff.gt.0.1) iqual = 1
      dir(1:5) = "'ELV'"
      write(lun,101) iyear, imon, iday , utc, jd,   &
                     scan%header%scannum, freq, elv, area, earea,   &
                     pos, epos, width, ewidth, peak, epeak, date,   &
                     dir, source, receiver, lsth, ":", lstm, ":",   &
                     lsts, azm, parangle, tau, tsys, trec, tamb,   &
                     pamb, rh, corr, iqual
   endif
   return
99  format(t1,a1,t5,i4,t10,i2,t13,i2,t16,f5.2,t22,f12.4,t37,i4,t43,f7.3,   &
           t52,f4.1,t60,f6.2,t68,f6.2,t75,f6.2,t83,f5.2,t90,f5.2,t97,   &
           f4.2,t104,f6.3,t111,f5.3,t118,a13,t133,a6,t141,a10,   &
           t154,a5,t161,i2.2,a1,i2.2,a1,i2.2,t171,f5.1,t179,f6.1,t186,   &
           f4.2,t191,f5.1,t197,f5.1,t203,f4.0,t208,f4.0,t213,f4.0,t218,f5.1,t224,a7)
100 format(t5,i4,t10,i2,t13,i2,t16,f5.2,t22,f12.4,t37,i4,t43,f7.3,   &
           t52,f4.1,t60,f6.2,t68,f6.2,t75,f6.2,t83,f5.2,t90,f5.2,t97,   &
           f4.2,t104,f6.3,t111,f5.3,t118,a13,t133,a6,t141,a10,   &
           t154,a5,t161,i2.2,a1,i2.2,a1,i2.2,t171,f5.1,t179,f6.1,t186,   &
           f4.2,t191,f5.1,t197,f5.1,t203,f4.0,t208,f4.0,t213,f4.0,t218,f5.1,t224,a7)
101 format(t5,i4,t10,i2,t13,i2,t16,f5.2,t22,f12.4,t37,i4,t43,f7.3,   &
           t52,f4.1,t59,f7.2,t68,f6.2,t75,f6.2,t83,f5.2,t90,f5.2,t97,   &
           f4.2,t103,f7.3,t111,f5.3,t118,a13,t133,a5,t141,a10,   &
           t154,a5,t161,i2.2,a1,i2.2,a1,i2.2,t171,f5.1,t179,f6.1,t186,   &
           f4.2,t191,f5.1,t197,f5.1,t203,f4.0,t208,f4.0,t213,f4.0,t218,f5.1,t224,i1)
end subroutine fluxfill

subroutine fluxBackend(lun,freq,iyear,imon,iday,month,ifb,nbd,nchan, &
                       tau,pwv,tsys,trec,fluxCorr)
!
! Same as fluxfill but for on-offs of continuum souces observed with a
! spectrometer and wobbler switch mode. Needs to be debugged ?
!

   use mira
   use pcross_definitions
   implicit none
   integer            :: i, ifb, iyear, imon, iday, i1, i2, j, lsth, lstm, lsts,   &
                         lun, nbd, nc, nchan, ncpb, nrec
   real*8             :: fluxCorr, freq, pwv, tau, tsys, trec
   character(len=  2) :: beFlag
   character(len=  3) :: month
   character(len=  9) :: receiver
   character(len= 10) :: source
   character(len= 13) :: date
   integer            :: iqual, ipix, k, l
   integer, dimension(3)     :: flagArray
   real*4             :: imbftsve, tint
   real*8             :: azm, bbflux, elv, eflux, flux, jd, pamb, parangle, &
                         rh, tamb, utc, var
   real*8, dimension(nchan)  :: aux
   real*8, dimension(nbd)    :: bbmean
   logical, dimension(nchan) :: mask
   logical                   :: error

   date(1:1) = "'"
   date(13:13) = "'"
   date(4:4) = "-"
   date(8:8) = "-"
   write(date(2:3),'(I2)') iday
   write(date(5:7),'(A3)') month
   write(date(9:12),'(I4)') iyear
   receiver = febe(ifb)%header%febe(1:5)
   nc = len_trim(febe(ifb)%header%febe)
   if (febe(ifb)%header%febe(nc-1:nc-1).eq.'/') then
      read(febe(ifb)%header%febe(nc:nc),'(i1)') i1
   else
      i1 = 1
   endif
   call sic_upper(receiver)
   if (index(receiver,'HERA').ne.0) then
      ipix = 5
      call gagout('W-LIST, defaults to central pixel.')
   else
      ipix = 1
   endif
   read(pr%header%mbftsver,'(f3.1)') imbftsve
   if (imbftsve.ge.2.0) then
      beFlag  = febe(ifb)%header%febe(7:7)//'0'
      if (beFlag(1:1).eq.'4') beFlag ='4M'
      receiver = receiver(1:5)//"-"//beFlag
      write(receiver(9:9),'(i1)') i1
   else
      beFlag(1:) = receiver(1:1)
      if (receiver(1:1).eq.'V') then
         if (receiver(2:4).eq.'100'.or.receiver(2:4).eq.'230') then
            receiver(1:1) = 'A'
         else if (receiver(2:4).eq.'150'.or.receiver(2:4).eq.'270') then
            receiver(1:1) = 'C'
         endif
      else if (receiver(1:1).eq.'H'.and.index(receiver,'HERA').eq.0) then
         if (receiver(2:4).eq.'100'.or.receiver(2:4).eq.'230') then
            receiver(1:1) = 'B'
         else if (receiver(2:4).eq.'150'.or.receiver(2:4).eq.'270') then
            receiver(1:1) = 'D'
         endif
      else if (receiver(1:1).eq.'R'.or.receiver(1:1).eq.'I') then
         receiver(1:1) = 'X'
      endif
      receiver(5:6) = beFlag(1:1)//'-'
      beFlag  = febe(ifb)%header%febe(6:6)//'0'
      if (beFlag(1:1).eq.'4') beFlag ='4M'
      receiver(7:8) = beFlag
      write(receiver(9:9),'(i1)') i1
   endif
   source = "'"//scan%header%object(1:8)//"'"
   tamb = nint(mon(ifb)%data%tamb_p_humid(1,1)+273.15)
   pamb = nint(mon(ifb)%data%tamb_p_humid(1,2))
   rh   = nint(mon(ifb)%data%tamb_p_humid(1,3))
   azm = nint(mon(ifb)%data%encoder_az_el(1,1)*10.)/10.
   elv = nint(mon(ifb)%data%encoder_az_el(1,2)*10.)/10.
   parangle = nint(mon(ifb)%data%parangle(1)*10.)/10.
   lsth = int(data(ifb)%data%lst(1)/3600.)
   lstm = int((data(ifb)%data%lst(1)-3600.*lsth)/60.)
   lsts = nint(data(ifb)%data%lst(1)-3600.*lsth-60.*lstm)
   utc = raw(1)%antenna(ifb)%subscanstart
   utc = nint((utc-int(utc))*2400)/100.
   jd = nint(raw(1)%antenna(ifb)%subscanstart*1.d4)/1.d4+2.4d6
   mask = data(ifb)%data%rdata(ipix,1:nchan).ne.blankingRed
   flux = sum(data(ifb)%data%rdata(ipix,1:nchan),mask)/count(mask)
   tint = sum(data(ifb)%data%integtim,mask)

   where (mask)
      aux = (data(ifb)%data%rdata(ipix,1:nchan)-flux)**2
   else where
      aux = blankingRed
   end where
   if (count(mask).gt.1) then
      eflux = sqrt(sum(aux,mask)/(count(mask)-1.))
   else
      eflux = blankingRed
   endif

   flagArray(1:3) = 0
   if (tsys.gt.300) flagArray(1) = 1
   do i = 1, febe(ifb)%header%febeband
      nrec = size(array(ifb)%data(i)%iswitch(:,1))
      i1 = array(ifb)%header(i)%dropchan+1
      ncpb = array(ifb)%header(i)%usedchan
      i2 = array(ifb)%header(i)%dropchan+ncpb
      mask(1:ncpb) = array(ifb)%data(i)%data(ipix,i1:i2,1,1).ne.blankingRed
      bbmean(i) = 0.
      do j = 1, nrec
         bbmean(i) = bbmean(i)       &
 &                   +abs(sum(array(ifb)%data(i)%data(ipix,i1:i2,j,1),mask(1:ncpb))  & 
 &                        -sum(array(ifb)%data(i)%data(ipix,i1:i2,j,2),mask(1:ncpb)) &
 &                    )/count(mask(1:ncpb))
      enddo
      bbmean(i) = bbmean(i)/float(nrec)
   enddo
   var = 0.
   if (febe(ifb)%header%febeband.gt.1) then
      bbflux = sum(bbmean)/febe(ifb)%header%febeband
      do i = 1, febe(ifb)%header%febeband
         var = var+(bbmean(i)-bbflux)*(bbmean(i)-bbflux)
      enddo
      var = var/(febe(ifb)%header%febeband-1)
      if (sqrt(var)/bbflux.gt.0.1) flagArray(2) = 1
   else if (eflux.eq.blankingRed.or.eflux/flux.gt.0.1) then
      flagArray(2) = 1 
   endif
   if (fluxCorr.ge.2) flagArray(3) = 1
   iqual = 100*flagArray(1)+10*flagArray(2)+flagArray(3)

   write(lun,100) iyear, imon, iday , utc, jd,   &
                  scan%header%scannum, freq, elv, flux, eflux,   &
                  date,source, receiver, lsth, ":", lstm, ":",   &
                  lsts, azm, parangle, tau, tsys, trec, tamb,   &
                  pamb, rh, pwv, tint, nsubscan, iqual 
   return
100 format(t5,i4,t10,i2,t13,i2,t16,f5.2,t22,f12.4,t37,i4,t43,f7.3,   &
           t52,f4.1,t60,f7.3,t76,f7.3,t88,a13,t102,a10,t113,a9,      &
           t123,i2.2,a1,i2.2,a1,i2.2,t132,f5.1,t138,f6.1,t147,       &
           f4.2,t152,f6.1,t159,f5.1,t165,f4.0,t170,f5.0,t176,f4.0,   &
           t181,f3.1,t185,f6.1,t193,i3,t198,i3.3)
end subroutine fluxBackend
