!--------------------------------------- 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 perturbObs(obsSpaceData,numAnalyses,indexAnalysis) 1,12
  !
  !Purpose:
  ! Perturb the innovation vector to simulate effect of observation uncertainty
  !
  ! WARNING: perturbations are not the same when MPI topology changes!!!
  !
  !Author  : M. Buehner, Dec, 2013
  !
  use obsSpaceData_mod
  implicit none

  type(struct_obs) :: obsSpaceData
  integer :: numAnalyses,indexAnalysis,numPerturbations
  integer :: nrandseed,iseed,indexMember,indexBody,indexFamily
  integer, parameter :: numFamily=9
  real*8  :: zdum,zmean,gasdev,originalOmp
  real*8  :: scaleFactor(numFamily)
  character(len=2) :: familyList(numFamily)
  real*8, save, pointer :: obsPerturbations(:,:) => NULL()
  logical, save :: firstTime = .true.

  write(*,*) '----------------------------------'
  write(*,*) '--Starting subroutine perturbObs--'
  write(*,*) '----------------------------------'

  familyList(1)='UA' ; scaleFactor(1)=1.00d0
  familyList(2)='AI' ; scaleFactor(2)=1.00d0
  familyList(3)='SF' ; scaleFactor(3)=1.00d0
  familyList(4)='TO' ; scaleFactor(4)=0.75d0
  familyList(5)='SW' ; scaleFactor(5)=0.50d0
  familyList(6)='SC' ; scaleFactor(6)=0.80d0
  familyList(7)='PR' ; scaleFactor(7)=1.00d0
  familyList(8)='RO' ; scaleFactor(8)=0.80d0
  familyList(9)='GP' ; scaleFactor(9)=1.00d0

  numPerturbations = numAnalyses

  if(firstTime) then

    if(.not.associated(obsPerturbations)) then
      write(*,*) 'perturbObs: allocating space for all perturbations'
      allocate(obsPerturbations(obs_numBody(obsSpaceData),numPerturbations))
    endif

    write(*,*) 'perturbObs: computing random numbers'

    nrandseed   = 1
    iseed     = ABS(nrandseed)
    zdum      = gasdev(-iseed)

    ! compute random perturbations
    do indexMember = 1,numPerturbations
      do indexBody = 1,obs_numBody(obsSpaceData)      
        obsPerturbations(indexBody,indexMember)=gasdev(1)*obs_bodyElem_r(obsSpaceData,obs_oer,indexBody)
      enddo
    enddo

    ! apply scale factor
    do indexFamily = 1,numFamily
      do indexBody = 1,obs_numBody(obsSpaceData)      
        if(obs_getFamily(obsSpaceData,bodyIndex=indexBody).eq.familyList(indexFamily)) then
          do indexMember = 1,numPerturbations
            obsPerturbations(indexBody,indexMember)=obsPerturbations(indexBody,indexMember)*scaleFactor(indexFamily)
          enddo
        endif
      enddo
    enddo

    ! remove ensemble mean
    do indexBody = 1,obs_numBody(obsSpaceData)      
      zmean=0.0d0
      do indexMember = 1,numPerturbations
        zmean=zmean+obsPerturbations(indexBody,indexMember)
      enddo
      zmean=zmean/numPerturbations
      do indexMember = 1,numPerturbations
        obsPerturbations(indexBody,indexMember)=obsPerturbations(indexBody,indexMember)-zmean
      enddo
    enddo

    firstTime=.false.

  endif

  ! apply perturbation for current analysis
  write(*,*) 'perturbObs: applying perturbation for member: ',indexAnalysis
  do indexBody = 1,obs_numBody(obsSpaceData)      
    originalOmp = obs_bodyElem_r(obsSpaceData,obs_omp,indexBody)
    call obs_bodySet_r(obsSpaceData,obs_omp,indexBody,originalOmp+obsPerturbations(indexBody,indexAnalysis))
  enddo

end subroutine perturbObs