subroutine solve(line,error)
!
! Called by subroutine run_mira (MIRA command "solve"). 
! Calls the appropriate subroutines and plotting procedures
! for solving cross-scan pointings, focus measurements (axial or lateral ones)
! and skydips.
!
! Input: command line from interactive MIRA session or ODP script.
! Output: error flag.
!
   use mira
   !
   implicit none
   !
   integer                :: i,idir, ifb,ibase,ipix,nbin,nc,nrecords
   integer                :: ifb1, ifb2
   integer ,dimension(2,1) :: idummy
   real*8, dimension(2,1) :: dummy
   character(len = *)     :: line
   character              :: string*17
   character(len=20)      :: tmpstring
   character(len=40)      :: string2
   character(len=80)      :: option
   character(len=200)     :: command
   logical                :: error, sic_present
   !
   command = line
   !
   tmpstring = scan%header%scantype
   call sic_upper(tmpstring)
   !
   ifb1 = 0
   ifb2 = 0
   !
   if (index(tmpstring,'POINT').ne.0) then
      option = 'POINTING'
   else if (index(tmpstring,'FOCUS').ne.0) then
      option = 'FOCUS'
   else if (index(tmpstring,'TIP').ne.0) then
      option = 'SKYDIP'
   else
      call gagout('E-SOLVE, works only for POINTING, FOCUS or TIP.')
      error = .true.
      return
   endif
   !
   call sic_upper(option)
   !
   if (.not.sic_present(0,1)) then
      ifb = 0
      do i = 1, scan%header%nfebe
         tmpstring = scan%data%febe(i)
         call sic_upper(tmpstring)
         if (index(tmpstring,'BBC').ne.0 .or. &
             index(tmpstring,'NBC').ne.0 .or. &
             index(tmpstring,'CONT').ne.0) then
            ifb = i
            exit
         endif
      enddo
      if (ifb.eq.0) then
         ifb = 1
         call gagout('W-SOLVE: using first backend in Fe/Be list.')
      endif
   else
      call sic_i4(line,0,1,ifb,.false.,error)
      if (ifb.gt.scan%header%nfebe.or.ifb.le.0) then
         call gagout('E-PLOT: Invalid backend specification.')
         error = .true.
         return
      endif
      if (sic_present(0,2)) then
         ifb1 = ifb
         call sic_i4(line,0,2,ifb2,.false.,error)
         if (ifb2.gt.scan%header%nfebe.or.ifb2.le.0) then
            call gagout('E-PLOT: Invalid backend specification.')
            error = .true.
            return
         endif
      endif
   endif
   !
   if (sic_present(1,0)) then
      call sic_i4(line,1,1,ipix,.false.,error)
   else
      ipix = febe(ifb)%data%reffeed
   endif
   if (ipix.gt.febe(ifb)%header%febefeed) then
      write(string,'(A14,I3)') 'No such pixel ',ipix
      call gagout('E-SOLVE: '//string)
      error = .true.
      return
   endif
   !
   if (.not.reduce(ifb)%calibration_done(3)) then
      nrecords = maxval(data(ifb)%data%integnum)
      if (febe(ifb)%header%febe(1:1).eq.'E') then
! No. of arguments have changed AS 11.10.2010
!         call subtract_offE(ifb,nrecords,'NONE',dummy,1,error)
         call subtract_offE(ifb,nrecords,'NONE',dummy,1,idummy,1,error)
      else
!         call subtract_off(ifb,nrecords,'NONE',dummy,1,error)
         call subtract_off(ifb,nrecords,'NONE',dummy,1,idummy,1,error)
      endif
   endif
   !
   if (.not.reduce(ifb)%calibration_done(2))   &
     call gagout('I-SOLVE: data are uncalibrated.')
   !
   tmpstring = scan%data%febe(ifb)
   call sic_upper(tmpstring)
   if (index(option,'POIN').ne.0) then
      if (reduce(ifb)%pointing_done)   &
        call gagout('I-SOLVE: Pointing already solved.')
      nbin = 0
      if (sic_present(2,0)) call sic_i4(line,2,1,nbin,.false.,error)
      if (index(tmpstring,'CONT').eq.0.and.   &
          index(tmpstring,'BBC').eq.0.and.   &
          index(tmpstring,'NBC').eq.0.and.   &
          index(tmpstring,'ABBA').eq.0) then
         call gagout('E-SOLVE: Not yet ready for line pointing.')
         error = .true.
         return
      endif
      if (sic_present(3,1)) then
         call sic_i4(line,3,1,ibase,.false.,error)
      else
         ibase = 1
      endif
      if (ibase.lt.0) then
         ibase = 0
         call gagout('W-SOLVE: baseline order has to be >= 0, '//   &
                     'reset to 0.')
      else if (ibase.gt.1) then
         ibase = 1
         call gagout('W-SOLVE: baseline order reset to 1 (maximum).')
      endif
      call solve_pointing_mira(ifb,ipix,nbin,ibase,line)
      if (ifb1.ne.0.and.ifb2.ne.0) then
         call sic_get_logi('doPause',dopause,error)
         if (dopause) call exec_program('pause')
         write(string2,'(A30,I4,I4)')   &
           '@gag_pro:p_alignment.mira yes ', ifb1, ifb2
         call exec_program(string2(1:39))
         if (.not.reduce(ifb2)%calibration_done(3)) then
            nrecords = maxval(data(ifb2)%data%integnum)
            if (febe(ifb2)%header%febe(1:1).eq.'E') then
!               call subtract_offE(ifb2,nrecords,'NONE',dummy,1,error)
               call subtract_offE(ifb2,nrecords,'NONE',dummy,1,idummy,1,error)
            else
!               call subtract_off(ifb2,nrecords,'NONE',dummy,1,error)
               call subtract_off(ifb2,nrecords,'NONE',dummy,1,idummy,1,error)
            endif
         endif
         call solve_pointing_mira(ifb2,ipix,nbin,ibase,line)
         if (dopause) call exec_program('pause')
         write(string2,'(A29,I4,I4)')   &
           '@gag_pro:p_alignment.mira no ', ifb1, ifb2
         call exec_program(string2(1:38))
      endif
   else if (index(option,'FOCUS').ne.0) then
      if (reduce(ifb)%focus_done)   &
        call gagout('I-SOLVE: Focus already solved.')
      if (index(tmpstring,'BBC').eq.0 .and.  &
          index(tmpstring,'NBC').eq.0 .and.  &
          index(tmpstring,'CONT').eq.0) then
         call gagout('E-SOLVE: Please select a continuum backend'   &
                     //' for focus.')
         error = .true.
         return
      endif
      if (raw(1)%subref(ifb)%focustransl.eq.'X') then
         idir = 1
      else if (raw(1)%subref(ifb)%focustransl.eq.'Y') then
         idir = 2
      else if (raw(1)%subref(ifb)%focustransl.eq.'Z') then
         idir = 3
      else
         call gagout('E-SOLVE: unknown focus translation direction.')
         error = .true.
         return
      endif
      call solve_xyzfocus(ifb,ipix,idir)
   else if (index(option,'SKYDIP').ne.0) then
      call solve_tip(ifb,ipix)
   else
      call gagout   &
        ('E-SOLVE: procedure either unknown or not yet done.')
      error = .true.
   endif
   !
   call sic_insert(command)
   !
   return
!
end subroutine solve
!
!
subroutine solve_pointing_mira(ifb,ipix,nbin,ibase,line)
!
! Called by subroutine SOLVE.
! solve_pointing_mira prepares (subscan or coadded Az- and
! El-subscan, after removal of linear baselines) data for
! subsequent call of telcal's subroutine fit_1d, writes
! the results into the corresponding MIRA and SIC structures,
! and calls subroutines protoResultsPointing to write an XML
! file with the results.
!
   use mira
   use fit
   use gildas_def
   use gkernel_types
   use gkernel_interfaces
   use telcal_interfaces
   use pcross_definitions
   use fit_definitions
   use linearregression
   !
   implicit none
   character(len = *) :: line
   !
   integer   :: i,ibase,idir,iend,ier,ifb,ilast,ipix,istart,isub,   &
                isub1,isub2,i1,i2,i3,i4,j,k,nbet,nbin,ndir,ndump,   &
                nlam,npar,npts,nrecords,nsubscans,nx,subscan_id
   type(sic_descriptor_t) :: desc
   integer, dimension(1)  :: imax
   real*4    :: azcorr, elcorr, data1, data2, yscale
   real*8    :: bval, dazm, delv, dx, slope, var, x1, x2, x3, x4
   real*8    :: dxmean
   real*8    :: xmaxval, xminval
   real*8    :: xend, xstart, yend, ystart
   logical   :: exist, error
   !
   integer, dimension(:), allocatable  :: indx
   real*8, dimension(:), allocatable   :: chi, xall, yall, xtmp, ytmp
   logical, dimension(:), allocatable  :: flagmask, mask, tmpmask
   logical, dimension(2)               :: overlapflag
   character(len=3)                    :: dir_string
   character(len=12)                   :: ptype
   character(len=20)                   :: tmpswtchmod
   character(len=32)                   :: tmpfebe, varname
   character(len=100)                  :: string
   !
   integer                             :: n, naver
   real*8                              :: xmax, xmin, ytest
   real*8, dimension(:), allocatable   :: ymax, ymin
   !
   type(simple_1d), dimension(2)       :: dat
   type(simple_1d), dimension(2)       :: profile
   !
   type tmppoint
      integer :: integnum
      integer :: subscan
      real*4  :: data
      real*8  :: latoff
      real*8  :: longoff
      real*8  :: lst
      real*8  :: elevatio
      real*8  :: parangle
   end type tmppoint
   !
   type(tmppoint), dimension(:), allocatable :: tmpdata
   !
   !
   tmpfebe = febe(ifb)%header%febe
   call sic_get_logi('flagBSwSpikes',flagBSwSpikes,error)
   call sic_upper(tmpfebe)
   !
   !
   tmpswtchmod = febe(ifb)%header%swtchmod
   call sic_upper(tmpswtchmod)
   if (index(tmpswtchmod,'WOB').ne.0) then
      ptype = 'DUAL'
   else
      ptype = 'SIMPLE'
   endif
   !
   !
   if (.not.reduce(ifb)%calibration_done(1).and.   &
       .not.reduce(ifb)%calibration_done(3)) then
      bval = blankingraw
   else
      bval = blankingred
   endif
   !
   !
   nrecords  = maxval(data(ifb)%data%integnum)
   nsubscans = scan%header%nobs
   !
   allocate(flagmask(nrecords),stat=ier)
   flagmask   &
     = data(ifb)%data%otfdata(ipix,1,1:nrecords).eq.bval
   !
   if (nbin.eq.0) then
      if (allocated(tmpdata)) deallocate(tmpdata,stat=ier)
      allocate(tmpdata(nrecords),stat=ier)
      if (allocated(chi)) deallocate(chi,stat=ier)
      allocate(chi(nrecords),stat=ier)
      tmpdata(1:nrecords)%integnum = data(ifb)%data%integnum
      tmpdata(1:nrecords)%subscan  = data(ifb)%data%subscan
      tmpdata(1:nrecords)%longoff  = data(ifb)%data%longoff
      tmpdata(1:nrecords)%latoff   = data(ifb)%data%latoff
      tmpdata(1:nrecords)%lst      = data(ifb)%data%lst
      tmpdata(1:nrecords)%elevatio = data(ifb)%data%elevatio
      tmpdata(1:nrecords)%parangle = data(ifb)%data%parangle
      tmpdata(1:nrecords)%data   &
        = data(ifb)%data%otfdata(ipix,1,1:nrecords)
   else
      !
      if (allocated(mask)) deallocate(mask,stat=ier)
      allocate(mask(nrecords),stat=ier)
      nrecords = 0
      do isub = 1, nsubscans
         mask = data(ifb)%data%subscan.eq.isub
         nrecords = nrecords+count(mask)/nbin
      enddo
      if (allocated(tmpdata)) deallocate(tmpdata,stat=ier)
      allocate(tmpdata(nrecords),stat=ier)
      if (allocated(chi)) deallocate(chi,stat=ier)
      allocate(chi(nrecords),stat=ier)
      iend = 0
      k = 0
      do isub = 1, nsubscans
         mask = data(ifb)%data%subscan.eq.isub
         ndump = count(mask)/nbin
         istart = iend+1
         ilast = iend+ndump*nbin
         iend = iend+count(mask)
         do j = istart, ilast, nbin
            k = k+1
            tmpdata(k)%subscan = isub
            tmpdata(k)%integnum = k
            tmpdata(k)%longoff   &
              = sum(data(ifb)%data%longoff(j:j+nbin-1))/nbin
            tmpdata(k)%latoff   &
              = sum(data(ifb)%data%latoff(j:j+nbin-1))/nbin
            tmpdata(k)%lst   &
              = sum(data(ifb)%data%lst(j:j+nbin-1))/nbin
            tmpdata(k)%elevatio   &
              = sum(data(ifb)%data%elevatio(j:j+nbin-1))/nbin
            tmpdata(k)%parangle   &
              = sum(data(ifb)%data%parangle(j:j+nbin-1))/nbin
            if (count(.not.flagmask(j:j+nbin-1)).eq.0) then
               tmpdata(k)%data = bval
            else
               tmpdata(k)%data   &
                 = sum(data(ifb)%data%otfdata(ipix,1,j:j+nbin-1),   &
                 1,.not.flagmask(j:j+nbin-1))   &
                 /count(.not.flagmask(j:j+nbin-1))
            endif
         enddo
      enddo
   !
   endif
   !
   !
   ! The following is if you want to point with the central pixel, but if
   ! the signal is in an off-center pixel.
   !      IF (INDEX(tmpFeBe,'HERA').NE.0) THEN
   !         IF (INDEX(FEBE(IFB)%HEADER%DEWRTMOD,'HORIZ').NE.0) THEN
   !            CHI = FEBE(IFB)%HEADER%DEWANG/RAD2DEG
   !            tmpData%LONGOFF = tmpData(:)%LONGOFF
   !     &                        +FEBE(IFB)%DATA%FEEDOFFX(IPIX)*COS(CHI(:))
   !     &                        -FEBE(IFB)%DATA%FEEDOFFY(IPIX)*SIN(CHI(:))
   !            tmpData%LATOFF = tmpData(:)%LATOFF
   !     &                        +FEBE(IFB)%DATA%FEEDOFFX(IPIX)*SIN(CHI(:))
   !     &                        +FEBE(IFB)%DATA%FEEDOFFY(IPIX)*COS(CHI(:))
   !         ELSE IF (INDEX(FEBE(IFB)%HEADER%DEWRTMOD,'CABIN').NE.0) THEN
   !            CHI = (FEBE(IFB)%HEADER%DEWANG-tmpData(:)%ELEVATIO)/RAD2DEG
   !            tmpData%LONGOFF = tmpData(:)%LONGOFF
   !     &                        +FEBE(IFB)%DATA%FEEDOFFX(IPIX)*COS(CHI(:))
   !     &                        -FEBE(IFB)%DATA%FEEDOFFY(IPIX)*SIN(CHI(:))
   !            tmpData%LATOFF = tmpData(:)%LATOFF
   !     &                       +FEBE(IFB)%DATA%FEEDOFFX(IPIX)*SIN(CHI(:))
   !     &                       +FEBE(IFB)%DATA%FEEDOFFY(IPIX)*COS(CHI(:))
   !         ELSE IF (INDEX(FEBE(IFB)%HEADER%DEWRTMOD,'EQUA').NE.0) THEN
   !            CHI = (FEBE(IFB)%HEADER%DEWANG+tmpData(:)%PARANGLE)/RAD2DEG
   !            tmpData%LONGOFF = tmpData(:)%LONGOFF
   !     &                        -FEBE(IFB)%DATA%FEEDOFFX(IPIX)*COS(CHI(:))
   !     &                        +FEBE(IFB)%DATA%FEEDOFFY(IPIX)*SIN(CHI(:))
   !            tmpData(:)%LATOFF = tmpData(:)%LATOFF
   !     &                       +FEBE(IFB)%DATA%FEEDOFFX(IPIX)*SIN(CHI(:))
   !     &                       +FEBE(IFB)%DATA%FEEDOFFY(IPIX)*COS(CHI(:))
   !         ENDIF
   !      ENDIF
   !
   nrecords  = maxval(tmpdata%integnum)
   nsubscans = maxval(tmpdata%subscan)
   if (allocated(ymin)) deallocate(ymin,stat=ier)
   if (allocated(ymax)) deallocate(ymax,stat=ier)
   allocate(ymin(nsubscans),ymax(nsubscans),stat=ier)
   ymax(:) = blankingraw
   ymin(:) = -ymax(:)
! changed by hw, 2010-05-06
!   if (nsubscans.gt.7) then
!      ndir = 8
!   else if (nsubscans.gt.3) then
!      ndir = 4
!   else
!      ndir = nsubscans
!   endif
! end of change
   if (mod(nsubscans,4).eq.0) then
      ndir = 4
   else
      ndir = nsubscans
   endif
!
! Normalize in order to avoid numerical problems with telCal's fitting routine
!
   yscale = maxval(abs(tmpdata(1:nrecords)%data),1,.not.flagmask)
   where (.not.flagmask)   &
     tmpdata(1:nrecords)%data = tmpdata(1:nrecords)%data/yscale
   !
   !
   i2 = 0
   dx = 0.
   dxmean = 0.
   subscan_loop: do i = 1, nsubscans
      xstart = raw(i)%antenna(ifb)%segmentxstart
      xend = raw(i)%antenna(ifb)%segmentxend
      ystart = raw(i)%antenna(ifb)%segmentystart
      yend = raw(i)%antenna(ifb)%segmentyend
      pcross(i)%sys = 0
      if (xend.gt.xstart) pcross(i)%dir = '+LAM'
      if (xend.lt.xstart) pcross(i)%dir = '-LAM'
      if (yend.gt.ystart) pcross(i)%dir = '+BET'
      if (yend.lt.ystart) pcross(i)%dir = '-BET'
      if (allocated(mask)) deallocate(mask,stat=ier)
      allocate(mask(nrecords),stat=ier)
      mask = tmpdata(1:nrecords)%subscan.eq.i
      call null_simple_1d(pcross(i)%dat)
      ndump = count(mask,1)
      allocate(pcross(i)%dat%x(ndump),stat=ier)
      allocate(pcross(i)%dat%y(ndump),stat=ier)
      allocate(pcross(i)%dat%w(ndump),stat=ier)
      allocate(pcross(i)%dat%d(ndump),stat=ier)
      pcross(i)%dat%n = ndump
      pcross(i)%dat%x = 0.
      pcross(i)%dat%y = 0.
      pcross(i)%dat%w = 1.
      pcross(i)%dat%d = 0.
      call null_simple_1d(pcross(i)%sol)
      npts = pcross(i)%dat%n
      pcross(i)%sol%n = npts
      allocate(pcross(i)%sol%x(npts),pcross(i)%sol%y(npts),   &
               pcross(i)%sol%w(npts),pcross(i)%sol%d(npts),   &
               stat=ier)
      pcross(i)%sol%x = 0.
      pcross(i)%sol%y = 0.
      pcross(i)%sol%w = 1.
      pcross(i)%sol%d = 0.
      i1 = i2+1
      i2 = i2+pcross(i)%dat%n
      allocate(indx(pcross(i)%dat%n),xtmp(pcross(i)%dat%n),   &
               ytmp(pcross(i)%dat%n),tmpmask(pcross(i)%dat%n),   &
               stat=ier)
      ytmp(:) = tmpdata(i1:i2)%data
      tmpmask(:) = flagmask(i1:i2)
      if (index(pcross(i)%dir,'LAM').ne.0) then
         xtmp(:) = tmpdata(i1:i2)%longoff*3600.
         if (index(pcross(i)%dir,'+').ne.0) then
            call indexx(pcross(i)%dat%n,xtmp,indx)
         else
            call indexx(pcross(i)%dat%n,-xtmp,indx)
         endif
      else if (index(pcross(i)%dir,'BET').ne.0) then
         xtmp(:) = tmpdata(i1:i2)%latoff*3600.
         if (index(pcross(i)%dir,'+').ne.0) then
            call indexx(pcross(i)%dat%n,xtmp,indx)
         else
            call indexx(pcross(i)%dat%n,-xtmp,indx)
         endif
      endif
      do j = 1, pcross(i)%dat%n
         pcross(i)%dat%x(j) = xtmp(indx(j))
      enddo
      !
      do j = 1, pcross(i)%dat%n
         if (.not.tmpmask(indx(j))) then
            pcross(i)%dat%y(j) = ytmp(indx(j))
         else
            pcross(i)%dat%y(j) = bval
            pcross(i)%dat%w = 0.0
         endif
      enddo
      deallocate(indx,xtmp,ytmp,tmpmask,stat=ier)
      !
      dx = max(dx,abs(maxval(pcross(i)%dat%x(2:npts)   &
                            -pcross(i)%dat%x(1:npts-1))))
      dxmean = dxmean+abs(sum(pcross(i)%dat%x(2:npts)   &
                             -pcross(i)%dat%x(1:npts-1)))   &
                      /(npts-1)
      !
      call null_function(pcross(i)%fun)
      pcross(i)%fun%method = 'SLATEC'
      if (ptype.eq.'SIMPLE'.or.index(pcross(i)%dir,'BET').ne.0) then
         pcross(i)%fun%name = 'GAUSSIAN+BASE'
         pcross(i)%fun%npar = 5
         npar = pcross(i)%fun%npar
         allocate (pcross(i)%fun%par(npar),stat=ier)
         do j = 1, npar
            call null_parameter(pcross(i)%fun%par(j))
         enddo
         pcross(i)%fun%par(5)%guess = 0.
         pcross(i)%fun%par(1)%guess = 1.-pcross(i)%fun%par(4)%guess
         if (array(ifb)%header(1)%restfreq.lt.1.2d11) then
            pcross(i)%fun%par(3)%guess   &
              = 27.5*0.88d+11/array(ifb)%header(1)%restfreq
         else if (array(ifb)%header(1)%restfreq.lt.1.9d11) then
            pcross(i)%fun%par(3)%guess   &
              = 16.0*1.5d+11/array(ifb)%header(1)%restfreq
         else if (array(ifb)%header(1)%restfreq.lt.4.0d11) then
            pcross(i)%fun%par(3)%guess   &
              = 10.5*2.3d+11/array(ifb)%header(1)%restfreq
         endif
         pcross(i)%fun%par(1)%guess =pcross(i)%fun%par(3)%guess  &
                                     *sqrt(pi/log(2.d0))/2.
         !
         ! MINI, MAXI not yet used by telCal
         !
       ! PCROSS(I)%FUN%PAR(1)%MINI = 0.
       ! PCROSS(I)%FUN%PAR(1)%MAXI = 1.E23
         pcross(i)%fun%flag = 2
         pcross(i)%fun%par(1)%name = 'AREA1'
         pcross(i)%fun%par(2)%name = 'POSITION1'
         pcross(i)%fun%par(3)%name = 'WIDTH1'
         pcross(i)%fun%par(4)%name = 'OFFSET'
         pcross(i)%fun%par(5)%name = 'SLOPE'
         if (ibase.eq.1) then
            pcross(i)%fun%par(1:5)%fixed = .false.
         else if (ibase.eq.0) then
            pcross(i)%fun%par(1:4)%fixed = .false.
            pcross(i)%fun%par(5)%fixed = .true.
         endif
         naver = pcross(i)%fun%par(3)%guess/dx
         xmax = maxval(pcross(i)%dat%x)
         xmin = minval(pcross(i)%dat%x)
         n = 0
         if (index(pcross(i)%dir,'+').ne.0) then
            do j = 1, pcross(i)%dat%n
               if (pcross(i)%dat%x(j)+pcross(i)%fun%par(3)%guess   &
                 .gt.xmax) exit
               n = n+1
            enddo
         else if (index(pcross(i)%dir,'-').ne.0) then
            do j = pcross(i)%dat%n,1,-1
               if (pcross(i)%dat%x(j)+pcross(i)%fun%par(3)%guess   &
                 .gt.xmax) exit
               n = n+1
            enddo
         endif
         if (n.eq.0) then
            naver = pcross(i)%dat%n
            n = 1
         endif
         i3 = 0
         do j = 1, n
            i4 = i3+naver
            i3 = i3+1
            ytest = sum(pcross(i)%dat%y(i3:i4))/(i4-i3+1)
            if (ytest.le.ymin(i)) then
               pcross(i)%fun%par(4)%guess = ytest
               ymin(i) = ytest
            endif
         enddo
         i3 = 0
         do j = 1, n
            i4 = i3+naver
            i3 = i3+1
            ytest = sum(pcross(i)%dat%y(i3:i4))/(i4-i3+1)-ymin(i)
            if (ytest.ge.ymax(i)) then
               pcross(i)%fun%par(2)%guess   &
                 = sum(pcross(i)%dat%x(i3:i4))/(i4-i3+1)
               ymax(i) = ytest
            endif
         enddo
      !
      else if (ptype.eq.'DUAL') then
         pcross(i)%fun%name = '2*GAUSSIAN+BASE'
         pcross(i)%fun%npar = 8
         npar = pcross(i)%fun%npar
         allocate (pcross(i)%fun%par(npar),stat=ier)
         do j = 1, npar
            call null_parameter(pcross(i)%fun%par(j))
         enddo
         pcross(i)%fun%par(7)%guess = 0.5*(minval(pcross(i)%dat%y)   &
                                          +maxval(pcross(i)%dat%y))
         pcross(i)%fun%par(8)%guess = 0.
         pcross(i)%fun%par(1)%guess = 1.-pcross(i)%fun%par(7)%guess
         imax = maxloc(pcross(i)%dat%y)
         pcross(i)%fun%par(2)%guess = pcross(i)%dat%x(imax(1))
         if (array(ifb)%header(1)%restfreq.lt.1.2d11) then
            pcross(i)%fun%par(3)%guess   &
              = 27.5*0.88d+11/array(ifb)%header(1)%restfreq
         else if (array(ifb)%header(1)%restfreq.lt.1.9d11) then
            pcross(i)%fun%par(3)%guess   &
              = 16.0*1.5d+11/array(ifb)%header(1)%restfreq
         else if (array(ifb)%header(1)%restfreq.lt.4.0d11) then
            pcross(i)%fun%par(3)%guess   &
              = 10.5*2.3d+11/array(ifb)%header(1)%restfreq
         endif
         pcross(i)%fun%par(1)%guess =pcross(i)%fun%par(3)%guess   &
                                    *sqrt(pi/log(2.d0))/2.
         pcross(i)%fun%par(4)%guess = -1
         pcross(i)%fun%par(5)%guess =scan%header%wobthrow*3600.
         pcross(i)%fun%par(6)%guess = 1
         pcross(i)%fun%flag = 2
         !
         ! MINI, MAXI not yet used by telCal
         !
         !            PCROSS(I)%FUN%PAR(1)%MINI = 0.
         !            PCROSS(I)%FUN%PAR(1)%MAXI = 1.E23
         pcross(i)%fun%par(1)%name = 'AREA1'
         pcross(i)%fun%par(2)%name = 'POSITION1'
         pcross(i)%fun%par(3)%name = 'WIDTH1'
         pcross(i)%fun%par(4)%name = 'AREA2/AREA1'
         !
         ! MINI, MAXI not yet used by telCal
         !
         !            PCROSS(I)%FUN%PAR(4)%MINI = -10.
         !            PCROSS(I)%FUN%PAR(4)%MAXI = 10.
         pcross(i)%fun%par(5)%name = 'POSITION2-POSITION1'
         pcross(i)%fun%par(6)%name = 'WIDTH2/WIDTH1'
         pcross(i)%fun%par(7)%name = 'OFFSET'
         pcross(i)%fun%par(8)%name = 'SLOPE'
         if (ibase.eq.1) then
            pcross(i)%fun%par(1:8)%fixed = .false.
         else if (ibase.eq.0) then
            pcross(i)%fun%par(1:7)%fixed = .false.
            pcross(i)%fun%par(8)%fixed = .true.
         endif
      endif
   enddo subscan_loop
   !
   dxmean = dxmean/nsubscans
   if (dx/dxmean.gt.3) dx = dxmean
   !
   !if (ndir.ge.2) then
      call sic_descriptor('PCROSS',desc,exist)
      if (.not.exist) call sic_defstructure('PCROSS',.true.,error)
      do i = 1, nsubscans
         write(varname,'(A10,I0)') 'PCROSS%SUB',i
         call define_sic_pointing(pcross(i),trim(varname),error)
         call fit_1d(pcross(i)%dat,pcross(i)%fun,.false.)
         pcross(i)%sol%x = pcross(i)%dat%x(:)
         call get_profile(pcross(i)%fun,pcross(i)%sol)
         npar = pcross(i)%fun%npar
         where (pcross(i)%dat%y.ne.bval)   &
           pcross(i)%dat%y = pcross(i)%dat%y*yscale
         pcross(i)%sol%y = pcross(i)%sol%y*yscale
         pcross(i)%fun%par(1)%value   &
           = pcross(i)%fun%par(1)%value*yscale
         pcross(i)%fun%par(1)%error   &
           = pcross(i)%fun%par(1)%error*yscale
         pcross(i)%fun%par(npar-1)%value   &
           = pcross(i)%fun%par(npar-1)%value*yscale
         pcross(i)%fun%par(npar-1)%error   &
           = pcross(i)%fun%par(npar-1)%error*yscale
         pcross(i)%fun%par(npar)%value   &
           = pcross(i)%fun%par(npar)%value*yscale
         pcross(i)%fun%par(npar)%error   &
           = pcross(i)%fun%par(npar)%error*yscale
         pcross(i)%fun%par(1)%guess   &
           = pcross(i)%fun%par(1)%guess*yscale
         pcross(i)%fun%par(npar-1)%guess   &
           = pcross(i)%fun%par(npar-1)%guess*yscale
         pcross(i)%fun%par(npar)%guess   &
           = pcross(i)%fun%par(npar)%guess*yscale
         ymin(i) = ymin(i)*yscale
         ymax(i) = ymax(i)*yscale
      enddo
      !
      !
      do i = 1, nsubscans, 4
         write(varname,'(A10,I0)') 'PCROSS%SUB',i
         write(string,'(A36,1X,I2,1X,I2)')   &
           '@ gag_pro:p_plot_pointBySubscan.mira', ifb, i
         call exec_program(string(1:43))
         do j = 1, ndir
            k = j+i-1
            if (k.gt.nsubscans) then
               call gagout('W-SOLVE: incomplete pointing')
               return
            endif
            npar = pcross(k)%fun%npar
            if (ptype.ne.'DUAL'.and.                   &
                (pcross(k)%fun%par(npar-1)%value.lt.   &
                 ymin(k)-abs(ymax(k)).or.              &
                 pcross(k)%fun%par(npar-1)%value.gt.   &
                 ymin(k)+2*abs(ymax(k))                &
                )) then
               if (j.le.2) then
                  write(string,'(A20,F4.1,A7)')'g\draw relocate -13 ',   &
                    -1.7-(j-1)*0.5, ' /box 1'
               else
                  write(string,'(A20,F4.1,A7)') 'g\draw relocate 0 ',   &
                    -1.7-(j-3)*0.5, ' /box 1'
               endif
               call exec_program(string)
               call exec_program('g\pen /col 1')
               write(string,'(A41,I0,A47)')   &
                 'label "Ambigeous baseline fit in subscan ',k,   &
                 '" /center 6'
               call exec_program(string)
               call exec_program('g\pen /def')
               write(string,'(A43,I0,A35)')   &
                 'W-SOLVE: Ambigeous baseline fit in subscan ',k,   &
                 ', only 0 order baseline subtracted.'
               call gagout(string)
            endif
            if (mod(k,4).eq.0) then
               call sic_get_logi('doPause',dopause,error)
               if (dopause) then
                  call exec_program('pause')
               else
                  call exec_program('sic wait 1')
               endif
               if (trim(line).eq.'SIC\QUIT') return
            endif
            if (mod(k,4).eq.0.) call exec_program('clear')
         enddo
      enddo
      !
      if (nsubscans.lt.scan%header%nobstotal) then
         call gagout('W-SOLVE: incomplete pointing')
         if (mod(nsubscans,4).ne.0) return
      endif
      !
      ! now remove fitted baseline before proceeding to final fit
      !
      do i = 1, nsubscans
         npar = pcross(i)%fun%npar
         if (ptype.ne.'DUAL'.and.                   &
             (pcross(i)%fun%par(npar-1)%value.lt.   &
              ymin(i)-abs(ymax(i)).or.              &
              pcross(i)%fun%par(npar-1)%value.gt.   &
              ymin(i)+2*abs(ymax(i))                &
             )) then
            pcross(i)%dat%y = pcross(i)%dat%y   &
              -pcross(i)%fun%par(npar-1)%guess
         else
            where (pcross(i)%dat%y.ne.bval)   &
              pcross(i)%dat%y = pcross(i)%dat%y   &
                               -pcross(i)%fun%par(npar-1)%value   &
                               -pcross(i)%fun%par(npar)%value*pcross(i)%dat%x
         endif
      enddo
   !
   !endif
   !
   !
   overlapflag(:) = .true.
   ndir = 2
   az_el_loop: do idir = 1, 2
      if (idir.eq.1) then
         dir_string = 'LAM'
      else
         dir_string = 'BET'
      endif
      x1 = +1.d23
      x2 = -1.d23
      x3 = -1.d23
      x4 = +1.d23
      nx = 0
      do i = 1, nsubscans
         if (index(pcross(i)%dir,dir_string).ne.0) then
            xminval = minval(pcross(i)%dat%x)
            xmaxval = maxval(pcross(i)%dat%x)
            x1 = min(x1,xminval)
            x2 = max(x2,xmaxval)
            x3 = max(x3,xminval)
            x4 = min(x4,xmaxval)
            nx = nx+pcross(i)%dat%n
         endif
      enddo
      !
      if (abs(x1).lt.1.d23.and.abs(x2).lt.1.d23.and.abs(x3).lt.1.d23   &
        .and.abs(x4).lt.1.d23) then
         if ((x4-x3)/(x2-x1).lt.0.5) then
            if (dir_string.eq.'LAM') then
               overlapflag(1) = .false.
            else if (dir_string.eq.'BET') then
               overlapflag(2) = .false.
            endif
         endif
      endif
      !
      if (allocated(mask)) deallocate(mask,stat=ier)
      if (allocated(xall)) deallocate(xall,stat=ier)
      if (allocated(yall)) deallocate(yall,stat=ier)
      !
      allocate(mask(nx),xall(nx),yall(nx),stat=ier)
      i2 = 0
      do i = 1, nsubscans
         if (index(pcross(i)%dir,dir_string).ne.0) then
            i1 = i2+1
            i2 = i2+pcross(i)%dat%n
            xall(i1:i2) = pcross(i)%dat%x
            if (abs(xall(i2)-xall(i1))/(x2-x1).lt.0.5.or.   &
              pcross(i)%fun%flag.ne.0) then
               yall(i1:i2) = bval
            else
               yall(i1:i2) = pcross(i)%dat%y
            endif
         endif
      enddo
      call null_simple_1d(dat(idir))
      dat(idir)%n = nint(abs(x2-x1)/dx)+1
      allocate(dat(idir)%x(dat(idir)%n),   &
               dat(idir)%y(dat(idir)%n),   &
               dat(idir)%w(dat(idir)%n),   &
               stat=ier)
      do i = 1, dat(idir)%n
         dat(idir)%x(i) = x1+(i-1)*dx
         mask = .false.
         where(abs(xall-dat(idir)%x(i)).lt.dx) mask = .true.
         where(yall.eq.bval) mask = .false.
         if (count(mask).ne.0) then
            dat(idir)%y(i) = sum(yall,1,mask)/count(mask)
            dat(idir)%w(i) = 1.d0
         else
            dat(idir)%y(i) = bval
            dat(idir)%w(i) = 0.
         endif
      enddo
      !
      ! normalize to maximum in order to avoid numerical problems in telCal's
      ! fitting routine
      !
      yscale = maxval(abs(dat(idir)%y),1,dat(idir)%y.ne.bval)
      where (dat(idir)%y.ne.bval)   &
             dat(idir)%y = dat(idir)%y/yscale
      !
      call null_function(fun(idir))
      fun(idir)%method = 'SLATEC'
      if (ptype.eq.'SIMPLE'.or.dir_string.eq.'BET') then
         fun(idir)%npar   = 5
      else if (ptype.eq.'DUAL') then
         fun(idir)%npar   = 8
      endif
      allocate (fun(idir)%par(fun(idir)%npar),stat=ier)
      call null_parameter(fun(idir)%par(1))
      fun(idir)%par(1)%name = 'AREA1'
      call null_parameter(fun(idir)%par(2))
      fun(idir)%par(2)%name = 'POSITION1'
      call null_parameter(fun(idir)%par(3))
      fun(idir)%par(3)%name = 'WIDTH1'
      !
      if (array(ifb)%header(1)%restfreq.lt.1.2d+11) then
         fun(idir)%par(3)%guess   &
           = 27.5*.88d+11/array(ifb)%header(1)%restfreq
      else if (array(ifb)%header(1)%restfreq.lt.1.9d+11) then
         fun(idir)%par(3)%guess   &
           = 16.0*1.5d+11/array(ifb)%header(1)%restfreq
      else if (array(ifb)%header(1)%restfreq.lt.4.0d+11) then
         fun(idir)%par(3)%guess   &
           = 10.5*2.3d+11/array(ifb)%header(1)%restfreq
      endif
      fun(idir)%par(1)%guess = fun(idir)%par(3)%guess   &
        *sqrt(pi/log(2.d0))/2.
      !
      ! MINI, MAXI not yet used by telCal
      !
      !         FUN(IDIR)%PAR(1)%MINI = 0.
      !         FUN(IDIR)%PAR(1)%MAXI = 1.E23
      if (ptype.eq.'SIMPLE'.or.dir_string.eq.'BET') then
         fun(idir)%name   = 'GAUSSIAN+BASE'
         call null_parameter(fun(idir)%par(4))
         fun(idir)%par(4)%name = 'OFFSET'
         call null_parameter(fun(idir)%par(5))
         fun(idir)%par(5)%name = 'SLOPE'
         fun(idir)%par(4)%guess = 0.
         fun(idir)%par(5)%guess = 0.
         if (ibase.eq.1) then
            fun(idir)%par(1:5)%fixed = .false.
         else if (ibase.eq.0) then
            fun(idir)%par(1:4)%fixed = .false.
            fun(idir)%par(5)%fixed = .true.
         endif
         naver = fun(idir)%par(3)%guess/dx
         xmax = maxval(dat(idir)%x)
         n = 0
         do j = 1, dat(idir)%n
            if (dat(idir)%x(j)+fun(idir)%par(3)%guess.gt.xmax) exit
            n = n+1
         enddo
         if (n.eq.0) then
            naver = dat(idir)%n
            n = 1
         endif
         ymax(idir) = blankingraw
         ymin(idir) = -blankingraw
         i1 = 0
         do j = 1, n
            i2 = i1+naver
            i1 = i1+1
            ytest = sum(dat(idir)%y(i1:i2))/(i2-i1+1)
            if (ytest.le.ymin(idir)) then
               fun(idir)%par(4)%guess = ytest
               ymin(idir) = ytest
            endif
         enddo
         i1 = 0
         do j = 1, n
            i2 = i1+naver
            i1 = i1+1
            ytest = sum(dat(idir)%y(i1:i2))/(i2-i1+1)-ymin(idir)
            if (ytest.ge.ymax(idir)) then
               !
               ! MINI, MAXI not yet used by telCal
               !
               !                  FUN(IDIR)%PAR(2)%MINI = MIN(DAT(IDIR)%X(I1),
               !     &                                        DAT(IDIR)%X(I2))
               !                  FUN(IDIR)%PAR(2)%MAXI = MAX(DAT(IDIR)%X(I1),
               !     &                                        DAT(IDIR)%X(I2))
               fun(idir)%par(2)%guess   &
                 = sum(dat(idir)%x(i1:i2))/(i2-i1+1)
               ymax(idir) = ytest
            endif
         enddo
      !
      else if (ptype.eq.'DUAL') then
         fun(idir)%name   = '2*GAUSSIAN+BASE'
         call null_parameter(fun(idir)%par(4))
         fun(idir)%par(4)%name = 'AREA2/AREA1'
         !
         ! MINI, MAXI not yet used by telCal
         !
         !            FUN(IDIR)%PAR(4)%MINI = -10.
         !            FUN(IDIR)%PAR(4)%MAXI = +10.
         call null_parameter(fun(idir)%par(5))
         fun(idir)%par(5)%name = 'POSITION2-POSITION1'
         call null_parameter(fun(idir)%par(6))
         fun(idir)%par(6)%name = 'WIDTH2/WIDTH1'
         call null_parameter(fun(idir)%par(7))
         fun(idir)%par(7)%name = 'OFFSET'
         call null_parameter(fun(idir)%par(8))
         fun(idir)%par(8)%name = 'SLOPE'
         fun(idir)%par(4)%guess = -1
         fun(idir)%par(5)%guess = scan%header%wobthrow*3600.
         fun(idir)%par(6)%guess = 1
         fun(idir)%par(7)%guess = 0.
         fun(idir)%par(8)%guess = 0.
         fun(idir)%par(2)%guess = -scan%header%wobthrow*1800.
         if (ibase.eq.1) then
            fun(idir)%par(1:8)%fixed = .false.
         else
            fun(idir)%par(1:7)%fixed = .false.
            fun(idir)%par(8)%fixed = .true.
         endif
      endif
      !
      call fit_1d(dat(idir),fun(idir),.false.)
      !         IF (ABS(FUN(IDIR)%PAR(5)%VALUE).GT.0.01) THEN
      !            FUN(IDIR)%PAR(5)%GUESS = 0.
      !            FUN(IDIR)%PAR(5)%FIXED = .true.
      !            CALL FIT_1D(DAT(IDIR),FUN(IDIR),.FALSE.)
      !            CALL GAGOUT(' ')
      !            IF (IDIR.EQ.1) THEN
      !               CALL GAGOUT('W-SOLVE: Baseline order for coadded azimuth'
      !     &                     //' data reset to 0.')
      !            ELSE IF (IDIR.EQ.2) THEN
      !               CALL GAGOUT('W-SOLVE: Baseline order for coadded'
      !     &                     //' elevation data reset to 0.')
      !            ENDIF
      !            CALL GAGOUT(' ')
      !         ENDIF
      !
      ! remove normalization
      !
      where (dat(idir)%y.ne.bval)   &
        dat(idir)%y = dat(idir)%y*yscale
      npar = fun(idir)%npar
      fun(idir)%par(1)%value = fun(idir)%par(1)%value*yscale
      fun(idir)%par(1)%error = fun(idir)%par(1)%error*yscale
      fun(idir)%par(1)%guess = fun(idir)%par(1)%guess*yscale
      fun(idir)%par(npar-1)%value =fun(idir)%par(npar-1)%value*yscale
      fun(idir)%par(npar-1)%error =fun(idir)%par(npar-1)%error*yscale
      fun(idir)%par(npar-1)%guess =fun(idir)%par(npar-1)%guess*yscale
      fun(idir)%par(npar)%value = fun(idir)%par(npar)%value*yscale
      fun(idir)%par(npar)%error = fun(idir)%par(npar)%error*yscale
      fun(idir)%par(npar)%guess = fun(idir)%par(npar)%guess*yscale
      ymin(idir) = ymin(idir)*yscale
      ymax(idir) = ymax(idir)*yscale
   enddo az_el_loop
   !
   do idir = 1, ndir
      call null_simple_1d(profile(idir))
      allocate(profile(idir)%x(dat(idir)%n),   &
               profile(idir)%y(dat(idir)%n),   &
               profile(idir)%w(dat(idir)%n),   &
               profile(idir)%d(dat(idir)%n),   &
               stat=ier)
      profile(idir)%n = dat(idir)%n
      profile(idir)%x = dat(idir)%x
      call get_profile(fun(idir),profile(idir))
      var = 0.
      do j = 1, dat(idir)%n
         var = var+(dat(idir)%y(j)-profile(idir)%y(j))**2
      enddo
      var = var/(dat(idir)%n-1)
      fun(idir)%rms = sqrt(var)
   !
   enddo
   if (ptype.eq.'DUAL') fun(1)%par(2)%value    &
                        =fun(1)%par(2)%value+scan%header%wobthrow*1.8d+3
   !
   ! remove baseline for plotting
   !
   do idir = 1, ndir
      if (fun(idir)%flag.ne.0) cycle
      npar = fun(idir)%npar
      if (ptype.ne.'DUAL'.and.           &
          (fun(idir)%par(npar-1)%value.lt.   &
           ymin(idir)-abs(ymax(idir)).or.   &
           fun(idir)%par(npar-1)%value.gt.   &
           ymin(idir)+2*abs(ymax(idir)))) then
         profile(idir)%y = profile(idir)%y   &
                          -fun(idir)%par(npar-1)%guess

         where (dat(idir)%y.ne.bval)   &
           dat(idir)%y = dat(idir)%y-fun(idir)%par(npar-1)%guess
         if (idir.eq.1) then
            call gagout('W-SOLVE: ambigeous baseline fit in azimuth,'   &
                        //' only 0 order baseline subtracted.')
         else if (idir.eq.2) then
            call gagout('W-SOLVE: ambigeous baseline fit in elevation,'   &
                        //' only 0 order baseline subtracted.')
         endif
      else
         profile(idir)%y = profile(idir)%y   &
                          -fun(idir)%par(npar-1)%value   &
                          -fun(idir)%par(npar)%value*profile(idir)%x
         where (dat(idir)%y.ne.bval)   &
           dat(idir)%y = dat(idir)%y-fun(idir)%par(npar-1)%value   &
                        -fun(idir)%par(npar)%value*profile(idir)%x
      endif
   enddo

   call pointing_to_sic(dat,fun,profile,error)
   write(string,'(A30,1X,I2)') '@ gag_pro:p_plot_pointing.mira',   &
                               ifb
   call exec_program(string(1:34))
   call sic_get_logi('writeXML',writexml,error)
   if (writexml) then
      call protoresultspointing(ifb,ipix,error)
      if (error) call gagout('E-SOLVE: Error in XML file writing.')
   endif
   !
   call gagout(' ')
   call gagout(' Corrections to be entered in PaKo (for angleUnit '//   &
               'arcsec):')
   azcorr = nint((mon(ifb)%header%iaobs_caobs_ieobs(2)*3.6d+3   &
                  +fun(1)%par(2)%value)*10)/10.
   elcorr = nint((mon(ifb)%header%iaobs_caobs_ieobs(3)*3.6d+3   &
                  +fun(2)%par(2)%value)*10)/10.
   write (string,'(A14,2(F6.1,1X))') ' SET POINTING ',azcorr, elcorr
   call gagout(' ')
   call gagout(string)
   call gagout(' ')
   do idir = 1, ndir
      npar = fun(idir)%npar
      if (ptype.ne.'DUAL'.and.                                         &
          (fun(idir)%par(npar-1)%value.lt.ymin(idir)-abs(ymax(idir))   &
           .or.fun(idir)%par(npar-1)%value.gt.                         &
           ymin(idir)+2*abs(ymax(idir))                                &
          )) then
         call exec_program('g\pen /col 1')
         if (idir.eq.1) then
            call exec_program('g\draw relocate -13 -2 /box 1')
            string ='label "Ambigeous baseline fit in azimuth, only'   &
                  //' 0 order baseline subtracted." /center 6'
            call exec_program(string)
         else if (idir.eq.2) then
            call exec_program('g\draw relocate -13 -3 /box 1')
            string ='label "Ambigeous baseline fit in elevation,'   &
                  //' only 0 order baseline subtracted." /center 6'
            call exec_program(string)
         endif
         call exec_program('g\pen /default')
      endif
   enddo
   if (.not.overlapflag(1)) then
      call gagout(' W-SOLVE: overlap of azimuth subscans < 60%')
      if (ibase.eq.1) then
         call gagout('          In case of doubts consider repeat '//   &
                     'or try SOLVE /BASE 0.')
      else
         call gagout('          In case of doubts consider repeat.')
      endif
      call gagout(' ')
      call exec_program('g\pen /col 1')
      call exec_program('g\draw relocate -13 -4 /box 1')
      string ='label "Overlap of azimuth subscans < 60%, " /center 6'
      call exec_program(string)
      string = 'label "in case of doubts consider repeat." /center 6'
      call exec_program(string)
      call exec_program('g\pen /def')
   endif
   if (.not.overlapflag(2)) then
      call gagout(' W-SOLVE: overlap of elevation subscans < 60%')
      if (ibase.eq.1) then
         call gagout('          In case of doubts consider repeat '//   &
                     'or try SOLVE /BASE 0.')
      else
         call gagout('          In case of doubts consider repeat.')
      endif
      call gagout(' ')
      call exec_program('g\pen /col 1')
      call exec_program('g\draw relocate -13 -5 /box 1')
      string   &
        = 'label "Overlap of elevation subscans < 60%, " /center 6'
      call exec_program(string)
      string = 'label "in case of doubts consider repeat." /center 6'
      call exec_program(string)
      call exec_program('g\pen /def')
   endif
   !
   reduce(ifb)%pointing_done = .true.
   !
   ! Cleaning
   call null_simple_1d(profile(1))
   call null_simple_1d(profile(2))
   call null_simple_1d(dat(1))
   call null_simple_1d(dat(2))
   !
   return
end subroutine solve_pointing_mira
!
!
!
subroutine pointing_to_sic(dat,fun,profile,error)
!
! Creates a SIC copy of Mira structure PNT (pointing results for
! co-added azimuth and elevation data). Results from individual
! pointing subscans are in telcal/sic structure PCROSS.
!
   use gildas_def
   use gkernel_types
   use gkernel_interfaces
   use telcal_interfaces
   use fit_definitions
   !
   implicit none
   !
   type(simple_1d), dimension(2) :: dat
   type(simple_1d), dimension(2) :: profile
   type(fit_fun), dimension(2)   :: fun
   !
   type(sic_descriptor_t) :: desc
   logical error, exist
   !
   call sic_descriptor('PNT',desc,exist)
   if (exist) call sic_delvariable('PNT',.false.,error)
   !
   call sic_defstructure('PNT',.true.,error)
   call sic_defstructure('PNT%AZM',.true.,error)
   call sic_defstructure('PNT%AZM%DATA',.true.,error)
   call sic_defstructure('PNT%AZM%FIT',.true.,error)
   call sic_defstructure('PNT%AZM%PROFILE',.true.,error)
   call sic_defstructure('PNT%ELV',.true.,error)
   call sic_defstructure('PNT%ELV%DATA',.true.,error)
   call sic_defstructure('PNT%ELV%GUESS',.true.,error)
   call sic_defstructure('PNT%ELV%FIT',.true.,error)
   call sic_defstructure('PNT%ELV%PROFILE',.true.,error)
   !
   call sic_defstructure('PNT%AZM%ERROR',.true.,error)
   call sic_defstructure('PNT%ELV%ERROR',.true.,error)
   !
   call sic_def_inte('PNT%AZM%DATA%N',dat(1)%n,0,0,.true.,error)
   call sic_def_dble('PNT%AZM%DATA%X',dat(1)%x,1,dat(1)%n,   &
                    .true.,error)
   call sic_def_dble('PNT%AZM%DATA%Y',dat(1)%y,1,dat(1)%n,   &
                     .true.,error)
   call sic_def_inte('PNT%ELV%DATA%N',dat(2)%n,0,0,.true.,error)
   call sic_def_dble('PNT%ELV%DATA%X',dat(2)%x,1,dat(2)%n,   &
                     .true.,error)
   call sic_def_dble('PNT%ELV%DATA%Y',dat(2)%y,1,dat(2)%n,   &
                     .true.,error)
   !
   call sic_def_inte('PNT%AZM%FIT%FLAG',fun(1)%flag,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%FIT%AREA',fun(1)%par(1)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%FIT%POSITION',fun(1)%par(2)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%FIT%WIDTH',fun(1)%par(3)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%FIT%OFFSET',fun(1)%par(4)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%FIT%SLOPE',fun(1)%par(5)%value,   &
                     0,0,.true.,error)
   call sic_def_inte('PNT%ELV%FIT%FLAG',fun(2)%flag,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%FIT%AREA',fun(2)%par(1)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%FIT%POSITION',fun(2)%par(2)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%FIT%WIDTH',fun(2)%par(3)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%FIT%OFFSET',fun(2)%par(4)%value,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%FIT%SLOPE',fun(2)%par(5)%value,   &
                     0,0,.true.,error)
   !
   call sic_def_dble('PNT%AZM%GUESS%AREA',fun(1)%par(1)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%GUESS%POSITION',fun(1)%par(2)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%GUESS%WIDTH',fun(1)%par(3)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%GUESS%OFFSET',fun(1)%par(4)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%GUESS%SLOPE',fun(1)%par(5)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%GUESS%AREA',fun(2)%par(1)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%GUESS%POSITION',fun(2)%par(2)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%GUESS%WIDTH',fun(2)%par(3)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%GUESS%OFFSET',fun(2)%par(4)%guess,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%GUESS%SLOPE',fun(2)%par(5)%guess,   &
                     0,0,.true.,error)
   !
   call sic_def_dble('PNT%AZM%PROFILE%X',profile(1)%x,1,profile(1)%n,   &
                     .true.,error)
   call sic_def_dble('PNT%AZM%PROFILE%Y',profile(1)%y,1,profile(1)%n,   &
                     .true.,error)
   call sic_def_dble('PNT%ELV%PROFILE%X',profile(2)%x,1,profile(2)%n,   &
                     .true.,error)
   call sic_def_dble('PNT%ELV%PROFILE%Y',profile(2)%y,1,profile(2)%n,   &
                     .true.,error)
   !
   call sic_def_dble('PNT%AZM%ERROR%AREA',fun(1)%par(1)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%ERROR%POSITION',fun(1)%par(2)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%ERROR%WIDTH',fun(1)%par(3)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%ERROR%OFFSET',fun(1)%par(4)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%AZM%ERROR%SLOPE',fun(1)%par(5)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%ERROR%AREA',fun(2)%par(1)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%ERROR%POSITION',fun(2)%par(2)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%ERROR%WIDTH',fun(2)%par(3)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%ERROR%OFFSET',fun(2)%par(4)%error,   &
                     0,0,.true.,error)
   call sic_def_dble('PNT%ELV%ERROR%SLOPE',fun(2)%par(5)%error,   &
                     0,0,.true.,error)
   !
   return
end subroutine pointing_to_sic

subroutine solve_xyzfocus(ifb,ipix,idir)
!
! Called by subroutine SOLVE.
! solve_xyzfocus prepares the data of a focus scan
! subsequent call of telcal's subroutine fit_1d, writes
! the results into the corresponding MIRA and SIC structures,
! and calls subroutines protoResultsFocus to write an XML
! file with the results.
!
   use mira
   use gildas_def
   use gkernel_types
   use gkernel_interfaces
   use telcal_interfaces
   use fit_definitions
   use focus_definitions
   !
   implicit none
   !
   character(len=40)                  :: string
   integer                            :: i,idir,ier,ifb,ipix,j,n,   &
                                         npar,nrecords,nsol,nsubscans
   type(sic_descriptor_t)             :: desc
   real*4                             :: dz,focusnew,min,max
   real*8                             :: val,var
   real*8, dimension(:), allocatable  :: offset
   logical                            :: error,exist
   logical, dimension(:), allocatable :: mask,offsetflag
   !
   type (focus)                       :: tmp
   !
   nrecords = maxval(data(ifb)%data%integnum)
   nsubscans = maxval(data(ifb)%data%subscan )
   !
   npar = 3   ! Parabola, Lorentzian or Gaussian fitting
   nsol = 100
   !
   if (allocated(mask)) deallocate(mask,stat=ier)
   allocate(mask(nrecords),stat=ier)
   if (allocated(offsetflag)) deallocate(offsetflag,stat=ier)
   allocate(offsetflag(nrecords),stat=ier)
   !
   n = 0
   offsetflag = .false.
   mask = .true.
   do i = 1, nsubscans
      mask = .not.offsetflag.and.mask
      if (count(mask).eq.0) exit
      n = n+1
      val =minval(data(ifb)%data%dfocus_x_y_z(1:nrecords,idir),   &
        1,mask)
      offsetflag = data(ifb)%data%dfocus_x_y_z(1:nrecords,idir)   &
        .eq.val
   enddo
   !
   if (allocated(offset)) deallocate(offset,stat=ier)
   allocate(offset(n),stat=ier)
   !
   n = 0
   offsetflag = .false.
   mask = .true.
   do i = 1, nsubscans
      mask = .not.offsetflag.and.mask
      if (count(mask).eq.0) exit
      n = n+1
      offset(n) =minval(data(ifb)%data%dfocus_x_y_z(1:nrecords,idir),   &
        1,mask)
      offsetflag = data(ifb)%data%dfocus_x_y_z(1:nrecords,idir)   &
        .eq.offset(n)
   enddo
   !
   !
   zfocus%sys = 0
   !
   call null_simple_1d(zfocus%dat(1))
   zfocus%dat(1)%n = n
   allocate(zfocus%dat(1)%x(zfocus%dat(1)%n),   &
            zfocus%dat(1)%y(zfocus%dat(1)%n),   &
            zfocus%dat(1)%w(zfocus%dat(1)%n),   &
            stat=ier)
   zfocus%dat(1)%x = 0.d0
   zfocus%dat(1)%x = 0.d0
   zfocus%dat(1)%w = 1.d0
   !
   call null_simple_1d(zfocus%sol(1))
   zfocus%sol(1)%n = nsol
   allocate(zfocus%sol(1)%x(nsol),zfocus%sol(1)%y(nsol),   &
            zfocus%sol(1)%w(nsol),zfocus%sol(1)%d(nsol),   &
            stat=ier)
   zfocus%sol(1)%x = 0.
   zfocus%sol(1)%y = 0.
   zfocus%sol(1)%w = 1.
   zfocus%sol(1)%d = 0.
   !
   call null_function(zfocus%fun(1))
   zfocus%fun(1)%name = 'POLYNOMIAL'
   zfocus%fun(1)%method = 'SLATEC'
   zfocus%fun(1)%npar = npar
   zfocus%fun(1)%flag = 0
   allocate(zfocus%fun(1)%par(npar),stat=ier)
   do i = 1, npar
      call null_parameter(zfocus%fun(1)%par(i))
      write(string,'(a12,i2)') 'COEFFICIENT ', i-1
      zfocus%fun(1)%par(i)%name = string
   enddo
   !
   mask = .false.
   do i = 1, zfocus%dat(1)%n
      mask = data(ifb)%data%dfocus_x_y_z(1:nrecords,idir)   &
        .eq.offset(i)
      zfocus%dat(1)%x(i) =   &
        maxval(data(ifb)%data%dfocus_x_y_z(1:nrecords,idir),mask)
      zfocus%dat(1)%y(i) =   &
        sum(data(ifb)%data%otfdata(ipix,1,1:nrecords),mask)   &
        /count(mask)
   enddo
   !
   if (idir.eq.1) then
      zfocus%dir(1) = '+FCX'
   else if (idir.eq.2) then
      zfocus%dir(1) = '+FCY'
   else if (idir.eq.3) then
      zfocus%dir(1) = '+FCZ'
   endif
   !
   call sic_descriptor('ZFOCUS',desc,exist)
   if (exist) call sic_delvariable('ZFOCUS',.false.,error)
   call define_sic_focus
   !
   min = minval(zfocus%dat(1)%x)
   max = maxval(zfocus%dat(1)%x)
   dz = max-min
   min = min-0.1*dz
   max = max+0.1*dz
   do i = 1, zfocus%sol(1)%n
      zfocus%sol(1)%x(i) = min+(max-min)*(i-1)/(zfocus%sol(1)%n-1)
   enddo
   !
   call exec_program('clear')
   !
   tmp%dat(1)%n = zfocus%dat(1)%n
   allocate(tmp%dat(1)%x(tmp%dat(1)%n),tmp%dat(1)%y(tmp%dat(1)%n),   &
            tmp%dat(1)%w(tmp%dat(1)%n),stat=ier)
   tmp%dat(1)%x = zfocus%dat(1)%x
   tmp%dat(1)%w = zfocus%dat(1)%w
   tmp%dat(1)%y = zfocus%dat(1)%y
   tmp%dat(1)%y = zfocus%dat(1)%y
   !
   call fit_1d(tmp%dat(1),zfocus%fun(1),.false.)
   call get_profile(zfocus%fun(1),zfocus%sol(1))
   !
   var = 0.d0
   do i = 1, 3
      val= zfocus%fun(1)%par(1)%value   &
          +zfocus%dat(1)%x(i)*(zfocus%fun(1)%par(2)%value   &
                              +zfocus%dat(1)%x(i)   &
                              *zfocus%fun(1)%par(3)%value)
      zfocus%fun(1)%rms = var+(val-zfocus%dat(1)%y(i))**2
   enddo
   zfocus%fun(1)%rms = sqrt(zfocus%fun(1)%rms)/2.d0
   call sic_get_logi('writeXML',writexml,error)
   if (writexml) then
      call protoresultsfocus(ifb,ipix,zfocus%fun,error)
      if (error) call gagout('E-SOLVE: Error in XML file writing.')
   endif
   !
   write(string,'(A28,I2,I3)') '@gag_pro:p_plot_focus.mira ',ifb,   &
     ipix
   call exec_program(string(1:34))
   !
   if (error) call gagout('E-SOLVE: Error in XML file writing.')
   !
   if (idir.eq.3) then
      call gagout(' ')
      call gagout(' Corrections to be entered in PaKo [mm]: ')
      focusnew = nint((-zfocus%fun(1)%par(2)%value   &
                       /(2.*zfocus%fun(1)%par(3)%value))*100)/100.
      write (string,'(A11,F6.2)') ' SET FOCUS ',focusnew
      call gagout(' ')
      call gagout(string)
      call gagout(' ')
   endif
   !
   reduce(ifb)%focus_done = .true.
   return
end subroutine solve_xyzfocus
!
!
!
subroutine solve_tip(ifb,ipix)
!
! Called from run_mira (MIRA command SOLVE if current scan is a 
! skytip). This subroutine is merely an interface to SIC routine
! where the skydip is solved (in mira/pro/p_plot_tip.mira).
!
!
   integer           :: ifb, ipix
   character(len=40) :: string
   !
   write(string,'(A25,I0,I3)') '@gag_pro:p_plot_tip.mira ',ifb, ipix
   call exec_program(string)
   !
   return
end subroutine solve_tip
!
subroutine linregress(basedata,basepar,bval)
   !
   use linearregression
   !
   implicit none
   !
   type(lg)                         :: basepar
   type(base), dimension(basepar%n) :: basedata
   real*8                           :: bval
   !
   real*8                           :: sumx, sumxx, sumxy, sumy,sumyy
   integer                          :: n
   type(base), dimension(basepar%n) :: squareddata
   logical, dimension(basepar%n)    :: mask
   !
   n = basepar%n
   squareddata(1:n)%x = basedata(1:n)%x*basedata(1:n)%x
   squareddata(1:n)%y = basedata(1:n)%y*basedata(1:n)%y
   mask = basedata(1:n)%y.ne.bval
   sumx = sum(basedata(1:n)%x,mask)
   sumy = sum(basedata(1:n)%y,mask)
   sumxx = sum(squareddata(1:n)%x,mask)
   sumyy = sum(squareddata(1:n)%y,mask)
   sumxy = sum(basedata(1:n)%x*basedata(1:n)%y,mask)
   !
   basepar%det = count(mask)*sumxx-sumx*sumx
   basepar%a = (sumxx*sumy-sumx*sumxy)/basepar%det
   basepar%b = (count(mask)*sumxy-sumx*sumy)/basepar%det
!
end subroutine linregress
