SUBROUTINE protoResultsCalibration(error)

   Use mira
   Use modulePakoXML
   Use moduleResultsToNCS
   Use gbl_format
   Use gkernel_interfaces

   Implicit None

   Integer            :: idPart, ibd, ier, ifb, iobs, ipix, k1, k2,            &
             &           LF, lun, mxchan, nfebe, nLam, nBet, nbd, nchan, npix, &
             &           scanN
   Real*4             :: bandwidth, imbftsve, peakError
   Real*8             :: frequency, frequencyImage, offset
   Real*8             :: foffx, foffy
   Real*8             :: tatms, tatmi, trx, tsys, tcal, tauzen, tauzenImage,&
             &           h2omm, phot, psky, pcold
   Character(len=256) :: vis_data
   Character(len=200) :: filename
   Character(len=128) :: site
   Character(len=20)  :: switchingMode, tmpString
   Character(len=15)  :: scanId
   Character(len=13)  :: backendName, frontendName, frontendNameCal
   Character(len=7)   :: scale
   Character(len=7)   :: doppler
   Character(len=4)   :: year
   Character(len=2)   :: day, month 
   Logical            :: error, ex, foundCal, lError, resetBe, resetCal, resetRx
   Logical, dimension(:,:), allocatable :: calMask


!   Call Message(2,1,'protoResults','runs')
!   Call Message(2,1,'protoResultsPointing',' starts writing')

   year  = scan%header%date_obs(1:4)
   month = scan%header%date_obs(6:7)
   day   = scan%header%date_obs(9:10)

   if (scan%header%scannum.lt.10) then
      write(filename,'(a20,a4,a2,a2,a1,i1,a4)') 'iram30m-calibration-',     &
 &                              year,month,day,'s',scan%header%scannum,'.xml'
   else if (scan%header%scannum.lt.100) then
      write(filename,'(a20,a4,a2,a2,a1,i2,a4)') 'iram30m-calibration-',     &
 &                              year,month,day,'s',scan%header%scannum,'.xml'
   else if (scan%header%scannum.lt.1000) then
      write(filename,'(a20,a4,a2,a2,a1,i3,a4)') 'iram30m-calibration-',     &
 &                              year,month,day,'s',scan%header%scannum,'.xml'
   else
      write(filename,'(a20,a4,a2,a2,a1,i4,a4)') 'iram30m-calibration-',     &
 &                              year,month,day,'s',scan%header%scannum,'.xml'
   endif
   call sic_get_char('visData',vis_data,ier,error)
   if (vis_data.eq.'.') then
      filename = './'//trim(filename)
   else
      inquire(file=trim(vis_data)//'/mira/results',exist=ex)
      if (.not.ex) then
        call gagout(' ')
        call gagout('W-SOLVE: subdirectory for XML file does not exist.')
        call gagout('         Reset to default (working directory).')
        call gagout(' ')
      else
         filename = trim(vis_data)//'/mira/results/'//trim(filename)
      endif
   endif

   ier = sic_getlun(lun)
   Open (unit=lun,file=filename, recl=facunf*512,     &
        &   status='unknown')
   Call pakoXMLsetOutputUnit(iUnit = lun, error = lError)
   Call pakoXMLsetIndent(iIndent = 2, error = lError)
   Call resultsToNCSwriteProlog(error = lError)

   tmpString = febe(1)%header%swtchmod
   call sic_upper(tmpString)
   if (index(tmpString,'WOB').ne.0) then
      switchingMode = 'wobblerSwitching'
   else if (index(tmpString,'TOT').ne.0) then
      switchingMode = 'totalPower'
   else if (index(tmpString,'BEAM').ne.0) then
      switchingMode = 'beamSwitching'
   endif

   if (index(scan%header%telescop,"30M").ne.0.or.                      &
   &   index(scan%header%telescop,"30m").ne.0)                         &
   &                site = "Pico Veleta"
   Call resultsToNCSsetOdpHeader(                                      &
        &              telescope   = scan%header%telescop,             &
        &              observatory = site,                             &
        &              odpSoftware = prim%header%creator,              &
        &              reset       = .True.,                           &
        &              error       = lError                            &
        &                       ) 
   Call resultsToNCSwriteOdpHeader(error = lError) 

   Call resultsToNCSsetMeasurementHeader(                              &
                       measurement        = "Calibration",             &
        &              sourceName         = trim(scan%header%object),  & 
        &              timeStamp          = scan%header%date_obs,      &
        &              azimuth            =                            &
	&                       real(mon(1)%data%encoder_az_el(1,1)),&
        &              elevation          =                            &
	&                       real(mon(1)%data%encoder_az_el(1,2)),&
        &              refraction         =                            &
	&                       real(mon(1)%data%refractio(1)),      &
        &              pressureAmbient    =                            &
	&                       real(mon(1)%data%tamb_p_humid(1,2)), &
        &              temperatureAmbient = 273.16+                    &
	&                       real(mon(1)%data%tamb_p_humid(1,1)), &
        &              humidityAmbient    =                            &
	&                       real(mon(1)%data%tamb_p_humid(1,3)), &
        &              switchingMode      = switchingMode,             &
        &              observingMode      = "calibrate",               &
        &              reset              = .True.,                    &
        &              error              = lError                     &
	&                        )
!
   write(scanId,'(a11,i4.4)') scan%header%date_obs(1:10)//'.', &
         &                    scan%header%scannum 

   resetRx  = .true.
   resetBe  = .true.
   resetCal = .true.

   Call resultsToNCSsetScanId(                       &
        &              scanId = scanId,              &
        &              scanN  = scan%header%scannum, &
!        &              reset  = .not.foundCal,       &
        &              reset  = .true.,              &
        &              error  = lError               &
        &              ) 
   Call resultsToNCSwriteMeasurementHeader(error = lError)
   
   nfebe  = scan%header%nfebe
   read(pr%header%mbftsver,'(f3.1)') imbftsve

   febeLoop1: do ifb = 1, nfebe
     
      npix   = febe(ifb)%header%febefeed 
      if (index(febe(ifb)%header%febe(1:4),'HERA').ne.0) then
         frontendName = febe(ifb)%header%febe(1:5)//" Pixel "
         write(frontendName(13:13),'(i1)') ipix
         frontendNameCal(1:5) = frontendName(1:5)
         LF = 13
      else if (imbftsve.lt.2) then
         frontendName(1:4) = febe(ifb)%header%febe(1:4)
         frontendNameCal(1:4) = frontendName(1:4)
         LF = 4
      else
         frontendName(1:5) = febe(ifb)%header%febe(1:5)
         frontendNameCal(1:5) = frontendName(1:5)
         LF = 5
      endif


      frequency = array(ifb)%header(1)%restfreq*1.d-9
      offset = ((data(ifb)%header%channels/2.+0.5-data(ifb)%header%crpx4f_2)  &
 &              *data(ifb)%header%cd4f_21)*1.d-9

      if (index(array(ifb)%header(1)%sideband,'LSB').ne.0) then
         frequencyImage = frequency+array(ifb)%header(1)%sbsep*1.d-9
      else
         frequencyImage = frequency-array(ifb)%header(1)%sbsep*1.d-9
      endif

      if (scan%header%movefram) then
         doppler = 'fixed'
      else
         doppler = 'Doppler'
      endif

      if (reduce(ifb)%calibration_done(1)) then
         scale = 'antenna'
      else
         scale = 'none'
      endif

      if (index(frontendName(1:4),'HERA').ne.0) then
         foffx = 0.
         foffy = 0.
      else
         foffx       = febe(ifb)%data%feedoffx(1)*3600.
         foffy       = febe(ifb)%data%feedoffy(1)*3600.
      endif

      Call resultsToNCSsetReceiver(                                       &
           &       name           = frontendName(1:LF),                   &
           &       frequency      = frequency,                            &   
           &       lineName       = array(ifb)%header(1)%transiti,        &   
           &       sideBand       = array(ifb)%header(1)%sideband,        &
           &       doppler        = Doppler,                              &
           &       width          = febe(ifb)%header%widenar,             &
           &       effForward     = febe(ifb)%data%etafss(1,1),           &
           &       effBeam        = febe(ifb)%data%beameff(1,1),          &
           &       scale          = scale,                                &
           &       gainImage      = febe(ifb)%data%gainimag(1,1),         &
           &       tempAmbient    = real(mon(ifb)%data%thotcold(1,1)),    &
           &       tempCold       = real(mon(ifb)%data%thotcold(1,2)),    &
           &       offset         = offset,                               &
           &       centerIF       = febe(ifb)%header%ifcenter*1.d-9,      &   
           &       frequencyImage = frequencyImage,                       &
           &       xOffsetNasmyth = real(foffx),                          &
           &       yOffsetNasmyth = real(foffy),                          &
           &       reset          = resetRx,                              &
           &       error          = lError                                &
           &                      )

      resetRx = .false.

      if (index(febe(ifb)%header%febe,'VESPA').ne.0) then
         backendName = 'VESPA'
      else if (index(febe(ifb)%header%febe,'FTS').ne.0) then
         backendName = 'FTS'
      else if (index(febe(ifb)%header%febe,'CONT').ne.0) then
         backendName = 'continuum' 
      else if (index(febe(ifb)%header%febe,'BBC').ne.0) then
         backendName = 'BBC' 
      else if (index(febe(ifb)%header%febe,'NBC').ne.0) then
         backendName = 'NBC' 
      else if (index(febe(ifb)%header%febe,'4MHZ').ne.0) then
         backendName = '4MHZ' 
      else if (index(febe(ifb)%header%febe,'1MHZ').ne.0) then
         backendName = '1MHZ' 
      else if (index(febe(ifb)%header%febe,'100KHZ').ne.0) then
         backendName = '100KHZ' 
      else if (index(febe(ifb)%header%febe,'WILMA').ne.0) then
         backendName = 'WILMA'
      endif

      k1 = index(febe(ifb)%header%febe,'/')+1
      if (k1.eq.1) then
         idPart = 1
      else
         k2 = len_trim(febe(ifb)%header%febe)
         read(febe(ifb)%header%febe(k1:k2),'(i3)') idPart
      endif   

      if (index(backendName,'continuum').eq.0) then
         bandwidth = real(array(ifb)%header(1)%cd4f_21                    &
           &              *data(ifb)%header%channels)*1.e-6
      else
         bandwidth = 1000. !need to distinguish here bb mode and nb mode
      endif

      Call resultsToNCSsetBackend(                                           &
           &       name  = backendName,                                      &
           &       nPart = idPart,                                           &
           &       resolution=abs(real(array(ifb)%header(1)%freqres))*1.e-6, &
           &       bandwidth  = bandwidth,                                   &
           &       fShift = real(offset),                                    &
           &       receiver = frontendName(1:LF),                            &
           &       nChannels = data(ifb)%header%channels,                    &
           &       reset     = resetBe,                                      &
           &       error = lError                                            &
           &       )


      resetBe = .false.

   enddo febeLoop1
   Call resultsToNCSwriteReceivers(error = lError)
   Call resultsToNCSwriteBackends(error = lError) 

   febeLoop2: do ifb = 1, nfebe

      pixelLoop: do ipix = 1, npix

         if (index(febe(ifb)%header%febe(1:4),'HERA').ne.0) then
            frontendNameCal = febe(ifb)%header%febe(1:5)//" Pixel "
            write(frontendNameCal(13:13),'(i1)') ipix
         else if (imbftsve.le.2.0) then
            frontendNameCal(1:4) = febe(ifb)%header%febe(1:4)
         else
            frontendNameCal(1:5) = febe(ifb)%header%febe(1:5)
         endif
        
         mxchan = size(gains(ifb)%trx,3)
         nbd    = febe(ifb)%header%febeband
         allocate (calMask(nbd,mxchan),stat=ier)
         calMask = gains(ifb)%trx(1:nbd,ipix,1:mxchan).ne.-1.
         trx     = sum(gains(ifb)%trx(1:nbd,ipix,1:mxchan),calMask)      &
 &                 /count(calMask)
         calMask = gains(ifb)%tcal(1:nbd,ipix,1:mxchan).ne.-1.
         tcal     = sum(gains(ifb)%tcal(1:nbd,ipix,1:mxchan),calMask)    &
 &                  /count(calMask)
         calMask = gains(ifb)%tsys(1:nbd,ipix,1:mxchan).ne.-1.
         tsys    = sum(gains(ifb)%tsys(1:nbd,ipix,1:mxchan),calMask)     &
 &                 /count(calMask)
         h2omm       = sum(gains(ifb)%h2omm(1:nbd,ipix,1:mxchan),calmask)&
 &                     /count(calMask)
         tatms       = sum(gains(ifb)%tatms(1:nbd,ipix,1:mxchan),calmask)&
 &                     /count(calMask)
         tatmi       = sum(gains(ifb)%tatmi(1:nbd,ipix,1:mxchan),calmask)&
 &                     /count(calMask)
         tauzen      = sum(gains(ifb)%tauzen(1:nbd,ipix,1:mxchan),calmask)&
 &                     /count(calMask)
         tauzenImage = sum(gains(ifb)%tauzenImage(1:nbd,ipix,1:mxchan),calmask)    &
 &                     /count(calMask)
         deallocate(calMask)
         phot        = 0.0
         psky        = 0.0
         pcold       = 0.0
         do ibd = 1, nbd
            nchan       = array(ifb)%header(ibd)%usedchan
            k1          = array(ifb)%header(ibd)%dropchan+1
            k2          = array(ifb)%header(ibd)%dropchan+nchan
            phot        = phot+sum(gains(ifb)%phot(ibd,ipix,k1:k2))/nchan
            psky        = psky+sum(gains(ifb)%psky(ibd,ipix,k1:k2))/nchan
            pcold       = pcold+sum(gains(ifb)%pcold(ibd,ipix,k1:k2))/nchan
         enddo
         psky        = psky/nbd
         phot        = phot/nbd
         pcold       = pcold/nbd

         foffx       = febe(ifb)%data%feedoffx(ipix)*3600.
         foffy       = febe(ifb)%data%feedoffy(ipix)*3600.

         frequency = array(ifb)%header(1)%restfreq*1.d-9
         offset =((data(ifb)%header%channels/2.+0.5-data(ifb)%header%crpx4f_2) &
 &               *data(ifb)%header%cd4f_21)*1.d-9

         if (index(array(ifb)%header(1)%sideband,'LSB').ne.0) then
            frequencyImage = frequency+array(ifb)%header(1)%sbsep*1.d-9
         else
            frequencyImage = frequency-array(ifb)%header(1)%sbsep*1.d-9
         endif

         Call resultsToNCSsetCalibrationResults(                       &
        &       name           = frontendNameCal(1:LF),                &
        &       frequency      = frequency,                            &   
        &       lineName       = array(ifb)%header(1)%transiti,        &   
        &       sideBand       = array(ifb)%header(1)%sideband,        &
        &       effForward     = febe(ifb)%data%etafss(ipix,1),        &
        &       effBeam        = febe(ifb)%data%beameff(ipix,1),       &
        &       gainImage      = febe(ifb)%data%gainimag(ipix,1),      &
        &       tempAmbient    = real(mon(ifb)%data%thotcold(1,1)),    &
        &       tempCold       = real(mon(ifb)%data%thotcold(1,2)),    &
        &       frequencyImage = frequencyImage,                       &
        &       xOffsetNasmyth = real(foffx),                          &
        &       yOffsetNasmyth = real(foffy),                          &
        &       lcalof         = real(gains(ifb)%lcalof*3600),         &
        &       bcalof         = real(gains(ifb)%bcalof*3600),         &
        &       h2omm          = real(h2omm),                          &
        &       trx            = real(trx),                            &
        &       tsys           = real(tsys),                           &
        &       tcal           = real(tcal),                           &
        &       tatms          = real(tatms),                          &
        &       tatmi          = real(tatmi),                          &
        &       tauzen         = real(tauzen),                         &
        &       tauzenImage    = real(tauzenImage),                    &
        &       pcold          = real(pcold),                          &
        &       phot           = real(phot),                           &
        &       psky           = real(psky),                           &
        &       reset          = resetCal,                             &
        &       error          = lError                                &
        &       )

         resetCal = .false.

      enddo pixelLoop

   enddo febeLoop2

   Call resultsToNCSwriteCalibrationResults(error = lError)

   Call resultsToNCSwriteMeasurementEnd(error = lError)

   Call resultsToNCSwriteEnd(error = lError)

   Close(Unit=lun)
   ier = gag_frelun(lun)

!  Call Message(2,1,'protoResultsCalibration',' finished writing')

   return

END SUBROUTINE protoResultsCalibration
