!-------------------------------------- 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 prdatabin(lobsSpaceData,nstepobs) 3,12
use mpivar_mod
use obsSpaceData_mod
use timeCoord_mod
, only: tim_getDatestamp
IMPLICIT NONE
type(struct_obs) :: lobsSpaceData
integer :: nstepobs
integer :: jstep,jobs,jfamily,jdata,iobs,idatabeg,idatend,nsize,ierr
integer, allocatable, dimension(:,:) :: idataass,inumheader
integer, allocatable, dimension(:,:) :: my_idataass,my_inumheader
integer, parameter :: nfamily=9
character*2 :: familylist(nfamily)
character*256 :: formatspec,formatspec2
real*8 :: stepObsIndex
allocate(idataass(nfamily,nStepObs+1))
allocate(my_idataass(nfamily,nStepObs+1))
my_idataass(:,:) = 0
allocate(inumheader(nfamily,nStepObs+1))
allocate(my_inumheader(nfamily,nStepObs+1))
my_inumheader(:,:) = 0
familylist(1)='UA'
familylist(2)='AI'
familylist(3)='SF'
familylist(4)='TO'
familylist(5)='SW'
familylist(6)='SC'
familylist(7)='PR'
familylist(8)='RO'
familylist(9)='GP'
do jobs = 1, obs_numheader
(lobsSpaceData)
call getStepObsIndex
(stepObsIndex,tim_getDatestamp
(),
& obs_headElem_i
(lobsSpaceData,OBS_DAT,jobs),
& obs_headElem_i
(lobsSpaceData,OBS_ETM,jobs),nstepobs)
if(stepObsIndex.gt.0.0d0) then
jstep=nint(stepObsIndex)
idatabeg = obs_headElem_i
(lobsSpaceData,OBS_RLN,jobs)
idatend = obs_headElem_i
(lobsSpaceData,OBS_NLV,jobs) + idatabeg - 1
do jfamily = 1, nfamily
if(obs_getfamily
(lobsSpaceData,jobs).eq.familylist(jfamily)) then
my_inumheader(jfamily,jstep)=my_inumheader(jfamily,jstep)+1
my_inumheader(jfamily,nStepObs+1)=my_inumheader(jfamily,nStepObs+1)+1
do jdata = idatabeg, idatend
if ( obs_bodyElem_i
(lobsSpaceData,OBS_ASS,jdata) .eq. 1) then
my_idataass(jfamily,jstep) = my_idataass(jfamily,jstep) + 1
my_idataass(jfamily,nStepObs+1) =
& my_idataass(jfamily,nStepObs+1) + 1
endif
enddo
endif
enddo
else
write(*,*) 'PRDATABIN: observation outside time window:',jobs,stepObsIndex
endif
enddo
formatspec='(1X,A6,":"'
do jstep=1,nStepObs
formatspec=trim(formatspec)//',1X,I6' ! this is for each time bin
enddo
formatspec=trim(formatspec)//',1X,I8' ! this is for the total
formatspec=trim(formatspec)//')'
formatspec2='(1X,A6,":"'
do jstep=1,nStepObs
formatspec2=trim(formatspec2)//',1X,I6'
enddo
formatspec2=trim(formatspec2)//',1X,A8)'
write(*,*)'-----------------------------------------------------------------'
write(*,*)'Distribution of number of headers over stepobs ON LOCAL PROCESSOR'
write(*,trim(formatspec2))'Bin#',(jstep,jstep=1,nStepObs),'Total'
do jfamily = 1, nfamily
write(*,trim(formatspec)) familylist(jfamily),(my_inumheader(jfamily,jstep)
& ,jstep=1,nStepObs+1)
enddo
write(*,trim(formatspec)) 'ALL',(sum(my_inumheader(:,jstep)),jstep=1,nStepObs+1)
write(*,*)'----------------------------------------------------------------'
write(*,*)'Distribution of assimilated data over stepobs ON LOCAL PROCESSOR'
write(*,trim(formatspec2))'Bin#',(jstep,jstep=1,nStepObs),'Total'
do jfamily = 1, nfamily
write(*,trim(formatspec)) familylist(jfamily),(my_idataass(jfamily,jstep)
& ,jstep=1,nStepObs+1)
enddo
write(*,trim(formatspec)) 'ALL',(sum(my_idataass(:,jstep)),jstep=1,nStepObs+1)
write(*,*)'----------------------------------------------------------------'
nsize=size(inumheader)
call rpn_comm_allreduce(my_inumheader,inumheader,nsize,
& "mpi_integer","mpi_sum","GRID",ierr)
deallocate(my_inumheader)
nsize=size(idataass)
call rpn_comm_allreduce(my_idataass,idataass,nsize,
& "mpi_integer","mpi_sum","GRID",ierr)
deallocate(my_idataass)
if(mpi_myid.eq.0) then
write(*,*)'----------------------------------------------------------------'
write(*,*)'Distribution of number of headers over stepobs ON ALL PROCESSORS'
write(*,trim(formatspec2))'Bin#',(jstep,jstep=1,nStepObs),'Total'
do jfamily = 1, nfamily
write(*,trim(formatspec)) familylist(jfamily),(inumheader(jfamily,jstep)
& ,jstep=1,nStepObs+1)
enddo
write(*,trim(formatspec)) 'ALL',(sum(inumheader(:,jstep)),jstep=1,nStepObs+1)
write(*,*)'---------------------------------------------------------------'
write(*,*)'Distribution of assimilated data over stepobs ON ALL PROCESSORS'
write(*,trim(formatspec2))'Bin#',(jstep,jstep=1,nStepObs),'Total'
do jfamily = 1, nfamily
write(*,trim(formatspec)) familylist(jfamily),(idataass(jfamily,jstep)
& ,jstep=1,nStepObs+1)
enddo
write(*,trim(formatspec)) 'ALL',(sum(idataass(:,jstep)),jstep=1,nStepObs+1)
write(*,*)'---------------------------------------------------------------'
endif
deallocate(idataass)
deallocate(inumheader)
end subroutine prdatabin