!-------------------------------------- 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_sumJo(lobsSpaceData,pjo) 1,20
! Purpose:
! Compute the sum of Jo contributions saved in OBS_JOBS
! Also, compute contribution of each family of observation (for
! diagnostic purposes)
!
! Author : S. Pellerin *ARMA/MRB January 2009
use mpivar_mod
use obsSpaceData_mod
use tovs_nl_mod
implicit none
real*8 pjo ! Total observation cost function
type(struct_obs) :: lobsSpaceData
integer :: index_body,itvs,isens,index_header,idata,idatend
real*8 :: dljoraob,dljoairep,dljosatwind,dljoscat,dljosurfc,dljotov
real*8 :: dljoprof,dljogpsro,dljogpsztd,pjo_1
real*8 :: dljotov_sensors(nsensors)
integer :: ierr
call tmg_start(81,'SUMJO')
dljogpsztd = 0.d0
dljoraob = 0.d0
dljoairep = 0.d0
dljosatwind = 0.d0
dljosurfc = 0.d0
dljoscat = 0.d0
dljotov = 0.d0
dljogpsro = 0.d0
dljoprof = 0.d0
dljotov_sensors(:) = 0.d0
do index_body=1,obs_numbody
(lobsSpaceData)
pjo_1 = obs_bodyElem_r
(lobsSpaceData,OBS_JOBS,index_body)
! total observation cost function
pjo = pjo + pjo_1
! subcomponents of observation cost function (diagnostic only)
select case(obs_getFamily
(lobsSpaceData,bodyIndex=index_body))
case('UA')
dljoraob = dljoraob + pjo_1
case('AI')
dljoairep = dljoairep + pjo_1
case('SW')
dljosatwind = dljosatwind + pjo_1
case('SF')
dljosurfc = dljosurfc + pjo_1
case('SC')
dljoscat = dljoscat + pjo_1
case('TO')
dljotov = dljotov + pjo_1
case('RO')
dljogpsro = dljogpsro + pjo_1
case('PR')
dljoprof = dljoprof + pjo_1
case('GP')
dljogpsztd = dljogpsztd + pjo_1
end select
enddo
do itvs =1,NOBTOV
index_header=ltovsno(itvs)
if (index_header > 0 ) then
IDATA = obs_headElem_i
(lobsSpaceData,OBS_RLN,INDEX_HEADER)
IDATEND = obs_headElem_i
(lobsSpaceData,OBS_NLV,INDEX_HEADER) + IDATA - 1
do index_body=IDATA,IDATEND
pjo_1 = obs_bodyElem_r
(lobsSpaceData,OBS_JOBS,index_body)
isens = lsensor (itvs)
dljotov_sensors(isens) = dljotov_sensors(isens) + pjo_1
enddo
endif
enddo
call mpi_allreduce_sumreal8scalar
(pjo,"GRID")
call mpi_allreduce_sumreal8scalar
(dljoraob,"GRID")
call mpi_allreduce_sumreal8scalar
(dljoairep,"GRID")
call mpi_allreduce_sumreal8scalar
(dljosatwind,"GRID")
call mpi_allreduce_sumreal8scalar
(dljosurfc,"GRID")
call mpi_allreduce_sumreal8scalar
(dljoscat,"GRID")
call mpi_allreduce_sumreal8scalar
(dljotov,"GRID")
call mpi_allreduce_sumreal8scalar
(dljogpsro,"GRID")
call mpi_allreduce_sumreal8scalar
(dljoprof,"GRID")
call mpi_allreduce_sumreal8scalar
(dljogpsztd,"GRID")
do isens = 1, nsensors
call mpi_allreduce_sumreal8scalar
(dljotov_sensors(isens),"GRID")
enddo
if(mpi_myid == 0) then
write(*,'(a15,f25.17)') 'Jo(UA) = ',dljoraob
write(*,'(a15,f25.17)') 'Jo(AI) = ',dljoairep
write(*,'(a15,f25.17)') 'Jo(SF) = ',dljosurfc
write(*,'(a15,f25.17)') 'Jo(SC) = ',dljoscat
write(*,'(a15,f25.17)') 'Jo(TO) = ',dljotov
write(*,'(a15,f25.17)') 'Jo(SW) = ',dljosatwind
write(*,'(a15,f25.17)') 'Jo(PR) = ',dljoprof
write(*,'(a15,f25.17)') 'Jo(RO) = ',dljogpsro
write(*,'(a15,f25.17)') 'Jo(GP) = ',dljogpsztd
write(*,*) ' '
write(*,'(1x,a)') 'For TOVS decomposition by sensor:'
write(*,'(1x,a)') '# plt sat ins Jo'
do isens=1,NSENSORS
write(*,'(4(i3,1x),f25.17)') isens,PLATFORM(isens),SATELLITE(isens),INSTRUMENT(isens),dljotov_sensors(isens)
enddo
write(*,*) ' '
endif
call tmg_stop(81)
end subroutine oda_sumJo