SUBROUTINE oda_nsumObs 1,3
use modmask, only : lmasksf_in,lmasksf_out,lmaskpp_in,lmaskpp_out
use modmask, only : lmaskto,lmaskgo,lmaskro,lmaskzp,lmask
use modmask, only : lmasktr, lmasktr_all
implicit none
!
#if defined (DOC)
c
c Purpose:
c Calculate the number of assimilated observations for each family
c
c Author : Y. Yang ARQI/AQRD January 2010, following S. Pellerin's
c routine oda_sumJo.
c This routine replaces numbobs.ftn in the previous var3d-chem
c version.
c
c Revision:
C Y. Yang Aug. 2010
C - Added storing of obs. number for each family for chi-2 test
C Y.J. Rochon Aug. 2010
C - Addition of CTRSTNID(JJ) and NETR(JJ) as output
C
#endif
!
#include "comlun.cdk"
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comdim.cdk"
#include "comchem.cdk"
#include "comoba.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
#include "partov.cdk"
#include "comchi2test.cdk"
!
INTEGER IBEGIN,ILAST,ILASTOB,IBEGINOB,IDATEND
INTEGER J,JDATA,IDATA,ITYP
LOGICAL LLOK
logical, dimension(ndata) :: llmask
integer,target :: nobsraob,nobsairep,nobssatwind,nobssurfc,nobstov
integer,target :: nobsgoes,nobsprof,nobsgpsro
integer :: nobssum1
integer, pointer :: nobssum
integer,target :: NOBSFM(NCMTMAX), NOBSALL_TR
integer jj
!
! Compute family contributions for diagnostic purposes
! The remaining of the code has no effect on the minimization
!
nobsraob = 0
nobsairep = 0
nobssatwind = 0
nobssurfc = 0
nobstov = 0
nobsgoes = 0
nobsgpsro = 0
nobsprof = 0
NOBSALL_TR= 0
NOBSFM= 0
NMBOBS_ASS(1:JPFILES+1) = 0.0
NMBOBS_TR(1:NCMTASSI) = 0.0
!
DO J = 1,NFILES
IF (NBEGINTYP(J) .GT. 0)THEN
select case(CFAMTYP(J))
case('UA')
llmask = lmaskpp_in .or. lmaskpp_out
nobssum1 = nsumObs
(nbegintyp(j),nendtyp(j),llmask)
nobsraob = nobsraob + nobssum1
llmask = lmasksf_in .or. lmasksf_out
nobssum => nobssurfc
case('AI')
llmask = lmaskpp_in .or. lmaskpp_out
nobssum => nobsairep
case('SW')
llmask = lmaskpp_in .or. lmaskpp_out
nobssum => nobssatwind
case('SF','SC')
llmask = lmasksf_in .or. lmasksf_out
nobssum => nobssurfc
case('TO')
llmask = lmaskto
nobssum => nobstov
case('GO')
llmask = lmaskgo
nobssum => nobsgoes
case('RO')
llmask = lmaskro
nobssum => nobsgpsro
case('PR')
llmask = lmaskzp
nobssum => nobsprof
case('TR')
do JJ=1,NCMTASSI
llmask = lmasktr(JJ,:)
nobssum => NOBSFM(JJ)
nobssum = nobssum + nsumObs
(nbegintyp(j),nendtyp(j),llmask)
end do
llmask = lmasktr_all
nobssum => NOBSALL_TR
end select
nobssum1 = nsumObs
(nbegintyp(j),nendtyp(j),llmask)
nobssum = nobssum + nobssum1
endif
end do
write(nulout,'')
write(nulout,'(a51)') 'Number of observations assimilated for each family'
write(nulout,'')
write(nulout,'(a17,I23)') 'Nobs(RAOB) = ',NOBSRAOB
write(nulout,'(a17,I23)') 'Nobs(AIREP) = ',NOBSAIREP
write(nulout,'(a17,I23)') 'Nobs(SURFC) = ',NOBSSURFC
write(nulout,'(a17,I23)') 'Nobs(ATOV) = ',NOBSTOV
write(nulout,'(a17,I23)') 'Nobs(GOES) = ',NOBSGOES
write(nulout,'(a17,I23)') 'Nobs(SATWIND)= ',NOBSSATWIND
write(nulout,'(a17,I23)') 'Nobs(PROF) = ',NOBSPROF
write(nulout,'(a17,I23)') 'Nobs(GPSRO) = ',NOBSGPSRO
if (NCMTASSI.GT.0) then
write(nulout,'(a17,I23)') 'Nobs(TR) = ',NOBSALL_TR
do JJ=1,NCMTASSI
write(nulout,'(a10,a4,a6,I23,a5,i7,1x,a9)')
1 ' Nobs(',CNAMANAL(JJ),') = ',NOBSFM(JJ),' for ',
2 NETR(JJ),CTRSTNID(JJ)
end do
end if
write(nulout,'')
! Store number of obs. for each family for chi-2 test
! the sequence has to follow that in ..CFAMOBS, STJO and STJO_TR
!
NMBOBS_ASS(1)=NOBSRAOB
NMBOBS_ASS(2)=NOBSAIREP
NMBOBS_ASS(3)=NOBSSATWIND
NMBOBS_ASS(4)=NOBSSURFC
NMBOBS_ASS(5)=NOBSTOV
NMBOBS_ASS(6)=NOBSGOES
NMBOBS_ASS(7)=NOBSGPSRO
NMBOBS_ASS(8)=NOBSPROF
NMBOBS_ASS(9)=NOBSALL_TR
NMBOBS_ASS(JPFILES+1)=SUM(NMBOBS_ASS(1:JPFILES))
!
do JJ=1,NCMTASSI
NMBOBS_TR(JJ)=NOBSFM(JJ)
end do
!
contains
function nsumObs(kbegin,klast,ll_mask) 3
!
integer :: nsumObs
integer, intent(in) :: kbegin,klast
logical, intent(in), dimension(ndata) :: ll_mask
!
! Local variables
!
integer :: jdata
nsumObs = 0
DO JDATA=kbegin,klast
IF (ll_mask(jdata)) THEN
nsumObs = nsumObs + 1
ENDIF
END DO
return
END function nsumObs
end subroutine oda_nsumObs