!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!

SUBROUTINE oda_sqrtRm1(lobsSpaceData,elem_dest_i,elem_src_i) 2,18
  use rmatrix_mod ,only : rmat_sqrtRm1, rmat_lnondiagr
  use obsSpaceData_mod
  use tovs_nl_mod, only : jpchmax,ltovsno,lsensor,tvs_Is_idburp_tovs
  implicit NONE
  ! Arguments
  type(struct_obs), intent(inout) :: lobsSpaceData
  integer, intent(in)  :: elem_dest_i ! destination index
  integer, intent(in)  :: elem_src_i  ! source index
  !Purpose:
  !Applied observation error variances to ROBDATA8(k_src,*)
  !and store it in the elem_src_s of lobsSpaceData
  !
  !Author  : S. Pellerin *ARMA/MRB January 2009
  !
  !Revision:
  ! L. Fillion, ARMA/EC, 5 Jun 2009. Introduce 1 Obs experiment.
  ! S. Heilliette ARMA. April 2013. Introduction of non-diagonal R matrix for AIRS and IASI
  INTEGER index_body,iass,index_header
  integer :: idata,idatend,idatyp,count,ichn
  real (8) :: x(jpchmax),y(jpchmax)
  integer :: list_chan(jpchmax)

  ! NOTE I tried using openMP on this loop, but it increased the cost from 4sec to 80sec!!!
  do index_header =1, obs_numHeader(lobsSpaceData)

     IDATA   = obs_headElem_i(lobsSpaceData,OBS_RLN,INDEX_HEADER)
     IDATEND = obs_headElem_i(lobsSpaceData,OBS_NLV,INDEX_HEADER) + IDATA - 1
     IDATYP  = obs_headElem_i(lobsSpaceData,OBS_ITY,INDEX_HEADER)
     
     if ( tvs_Is_idburp_tovs(idatyp) .and. rmat_lnondiagr) then
        
        count=0
        do index_body=idata,idatend
           iass = obs_bodyElem_i(lobsSpaceData,OBS_ASS,index_body)
           if(iass.eq.1 .or. iass.eq.-1) then
              ICHN = NINT(obs_bodyElem_r(lobsSpaceData,OBS_PPP,INDEX_BODY))
              ICHN = MAX(0,MIN(ICHN,JPCHMAX+1))
              count=count+1
              list_chan(count)=ichn
              x(count)=obs_bodyElem_r(lobsSpaceData,elem_src_i,index_body)
           endif
        enddo

        if (count>0) then
           call rmat_sqrtRm1(lsensor(ltovsno(index_header)), count, x(1:count), y(1:count), list_chan(1:count), ltovsno(index_header) )

           count=0
           do index_body=idata,idatend
              iass = obs_bodyElem_i(lobsSpaceData,OBS_ASS,index_body)
              if(iass.eq.1 .or. iass.eq.-1) then
                 count=count+1
                 call obs_bodySet_r(lobsSpaceData, elem_dest_i, index_body,y(count))
              endif
           enddo
        endif
        
     else
     
        do index_body=idata,idatend
           iass = obs_bodyElem_i(lobsSpaceData,OBS_ASS,index_body)
           if(iass.eq.1 .or. iass.eq.-1) then
              call obs_bodySet_r(lobsSpaceData, elem_dest_i, index_body, &
                   obs_bodyElem_r(lobsSpaceData,elem_src_i,index_body)/obs_bodyElem_r(lobsSpaceData,OBS_OER,index_body))
           endif
        enddo
     end if

  enddo

END SUBROUTINE oda_sqrtRm1