SUBROUTINE RD_OBS_BOXES

!**** SUBROUTINE RD_OBS_BOXES - READ OBS_BOXES FILE

!     PURPOSE
!     -------
!       EXTRACT FROM THE OBS_BOXES FILE GLOBAL INFORMATION NEEDED
!       ABOUT THE CONTENTS OF THE CMAFILES

!     MODIFICATIONS
!     -------------
!        M. HAMRUD    96-04-20 : ORIGINAL (ECMWF)
!        M. HAMRUD    15/10/96 : 4-D VAR
!        M. HAMRUD    25/10/97 : Message passing 
!        E.ANDERSSON  03/07/98 : Global number of TOVS data
!        D.Dent      00-09-01 : convert from MPE to MPL
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      15-Feb-2005 New-style GOM arrays
!        S Healy       11-May-2005 Namelist for setting NOBSPROF
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIMO  , ONLY : NOBTOT  ,NOBTOTG   ,NACTIM  ,&
 & NOBTOTM  ,NOBTOV   ,NOBSCA ,NOBNTV    ,NOBTOVG ,&
 & NOBTOVBP ,NOBTOVMX ,NOBPROF, NOBPROFG ,NOBNTVG ,&
 & NOBNTVBP 
USE YOMCT0   , ONLY : NSTOP    ,NPROC    ,NPRINTLEV,LALLOPR
USE YOMMP    , ONLY : MYPROC
USE YOMLUN   , ONLY : NULOUT   ,NULERR   ,NULNAM
USE YOMCOCTP , ONLY : NOOBST   ,NSATEM   ,NSCATT , NPAOB, & 
 & NPILOT  , NTEMP , NDRIBU, NSATOB , NAIREP , NSYNOP
USE YOMECTAB , ONLY : NTSLPT   ,NTSLTOB  ,NTSLTOBOFF,NTSLTOBG ,&
 & NTSLTOBM ,NTSLTOV  ,NTSLTOVOFF,NTSLNTV  ,NOBSPROFS,&
 & NTSLNTVOFF,NTSLSCA ,NTSLSCAOFF ,NTSLPROF
USE YOMGLOBS , ONLY : NOBTOTP  ,NTSLTOBP
USE YOMVAR   , ONLY : LTOVSCV  ,LTSCV

IMPLICIT NONE

#include "namnprof.h"

INTEGER(KIND=JPIM) :: IOBTOTPAT(NPROC)
INTEGER(KIND=JPIM) :: IOBSTYPAT(NPROC,NOOBST)
INTEGER(KIND=JPIM) :: ITSLTOB(NPROC,NACTIM)
INTEGER(KIND=JPIM) :: ITSLTPROF(NPROC,NACTIM)
INTEGER(KIND=JPIM) :: IOBSTYP(NPROC,NACTIM,NOOBST)
LOGICAL   :: LLOBSMASK(NOOBST)
LOGICAL :: LLP,LL4DVAR
INTEGER(KIND=JPIM) :: IU
INTEGER(KIND=JPIM) :: IOBTOTGAT ! Total # of obs in all CMA files
INTEGER(KIND=JPIM) :: ILROTYP,IUROTYP ! Obstype range
INTEGER(KIND=JPIM) :: I
INTEGER(KIND=JPIM) :: ITOTOBS,IOFFTOT,IOFFTOV,IOFFNTV,IOFFSCA
INTEGER(KIND=JPIM) :: JROC,JTS,J
INTEGER(KIND=JPIM) :: IDBINFO(size(IOBSTYP)), IRET
REAL(KIND=JPRB) :: ZINFO(1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "getdb.h"
#include "putdb.h"
END INTERFACE

#include "abor1.intfb.h"
#include "posnam.intfb.h"

!     ------------------------------------------------------------------
!*       1.    READ AND EXTRACT INFO FROM OBS_BOXES.
!              ------------------------------------

!*       1.O   ALLOCATE ARRAYS

IF (LHOOK) CALL DR_HOOK('RD_OBS_BOXES',0,ZHOOK_HANDLE)
LLP = NPRINTLEV >= 1.OR. LALLOPR
IU = NULOUT
WRITE(NULOUT,*) ' ENTER RD_OBS_BOXES'
ALLOCATE(NOBTOTP(NPROC))
IF(LLP)WRITE(IU,9) 'NOBTOTP ',SIZE(NOBTOTP),SHAPE(NOBTOTP)
ALLOCATE(NTSLTOBP(NPROC,NACTIM))
IF(LLP)WRITE(IU,9) 'NTSLTOBP',SIZE(NTSLTOBP),SHAPE(NTSLTOBP)

LL4DVAR = NSTOP > 1

!*       1.1   OPEN FILE

!--ODB-approach

IDBINFO(:) =  0

! Default number of profiles per ob-type

NOBSPROFS(:) = 1

! read in NOBSPROFS from namelist

CALL POSNAM(NULNAM,'NAMNPROF')
READ (NULNAM,NAMNPROF)

ILROTYP = 1
IUROTYP = NOOBST

IRET = 0
CALL GSTATS(1767,0)
CALL GETDB('OBS_BOXES', 0, IRET, IDBINFO, size(IDBINFO),ZINFO,0, &
 & -1, NACTIM, -1, NOOBST, -1, -1)  
CALL PUTDB('OBS_BOXES', 0, IRET, IDBINFO, size(IDBINFO),ZINFO,0)
CALL GSTATS(1767,1)

LLOBSMASK(:) = .TRUE.
LLOBSMASK(NSATEM) = .FALSE.
LLOBSMASK(NSCATT) = .FALSE.

i = 0
do j=1,NOOBST
  do jts=1,NACTIM
    do jroc=1,NPROC
      i = i + 1
      IOBSTYP(jroc,jts,j) = IDBINFO(i)
    enddo
  enddo
enddo

IOBTOTGAT = sum(IDBINFO(:))
do jts=1,NACTIM
  do jroc=1,NPROC
    ITSLTOB(jroc,jts) = sum(IOBSTYP(jroc,jts,:))
    ITSLTPROF(jroc,jts) = sum(IOBSTYP(jroc,jts,:)*NOBSPROFS(:))
  enddo
enddo
NOBPROFG = SUM(ITSLTPROF(:,:))
do jroc=1,NPROC
  IOBTOTPAT(jroc) = sum(IOBSTYP(jroc,:,:))
enddo
do j=1,NOOBST
  do jroc=1,NPROC
    IOBSTYPAT(jroc,j) = sum(IOBSTYP(jroc,:,j))
  enddo
enddo

!     ------------------------------------------------------------------
!*       3.    SAVE INFORMATION.
!              ----------------

WRITE(NULOUT,*) ' IOBTOTGAT=',IOBTOTGAT,' IOBTOTPAT=',IOBTOTPAT
WRITE(NULOUT,*) ' IOBSTYPAT (my proc.) ',(IOBSTYPAT(MYPROC,J),J=1,IUROTYP)

IF (LL4DVAR) THEN

!*       3.1   4-D var specific

  DO JTS = 1 , NACTIM
    NTSLTOB(JTS) = ITSLTOB(MYPROC,JTS)
    NTSLPROF(JTS) = ITSLTPROF(MYPROC,JTS)
    NTSLSCA(JTS) = IOBSTYP(MYPROC,JTS,NSCATT)
    NTSLTOV(JTS) = IOBSTYP(MYPROC,JTS,NSATEM)
    NTSLNTV(JTS) = SUM(IOBSTYP(MYPROC,JTS,:),MASK=LLOBSMASK(:))
    ITOTOBS = NTSLNTV(JTS) + NTSLSCA(JTS) + NTSLTOV(JTS)
    IF (ITOTOBS /= NTSLTOB(JTS)) THEN
      WRITE(NULERR,'(A,I8,2A,I8,A,I4)')&
       & ' TOTAL NUMB. OF OBS. ',NTSLTOB(JTS),' NOT EQUAL ',&
       & ' TO SUM OF SUBSETS ', ITOTOBS,' FOR TIMESLOT ',JTS  
      CALL ABOR1('RD_OBS_BOXES: ITOTOBS /= NTSLTOB(JTS)')
    ENDIF
    NOBTOT  = IOBTOTPAT(MYPROC)
    NOBTOTG = IOBTOTGAT
    NOBTOTM = MAXVAL(IOBTOTPAT)
    DO JROC = 1 , NPROC
      NOBTOTP(JROC) = IOBTOTPAT(JROC)
      NTSLTOBP(JROC,JTS) = ITSLTOB(JROC,JTS)
    ENDDO
    NTSLTOBG(JTS) = SUM(NTSLTOBP(:,JTS))
    NTSLTOBM(JTS) = MAXVAL(NTSLTOBP(:,JTS))
    WRITE(NULOUT,'(A,I5,A,I10,/,A,I10,A,I10)') 'TIMESLOT: ',JTS,&
     & ' GLOBAL NO OF OBS/TIMESLOT AND FOR EACH PROC ',NTSLTOBG(JTS),&
     & ' OPTIMAL PER PROC:',(NTSLTOBG(JTS)+NPROC-1)/NPROC,&
     & ' MAXIMUM INBALANCE BETWEEN PROC:',&
     & MAXVAL(NTSLTOBP(1:NPROC,JTS)) - MINVAL(NTSLTOBP(1:NPROC,JTS))  
    WRITE(NULOUT,'(10I8)') (NTSLTOBP(JROC,JTS),JROC=1,NPROC)
  ENDDO
  WRITE(NULOUT,'(A,5X,A,2I10)') ' SUMMARY: ',&
   & ' MIN & MAX NO OF OBS/TIMESLOT, FOR EACH PROC ',&
   & MINVAL(NTSLTOBG(1:NACTIM)),MAXVAL(NTSLTOBG(1:NACTIM))  
  WRITE(NULOUT,*)'MIN. VALUES (FOR EACH PROC OVER ALL TIMESLOTS):'
  WRITE(NULOUT,'(10I8)') (MINVAL(NTSLTOBP(JROC,1:NACTIM)),JROC=1,NPROC)
  WRITE(NULOUT,*)'MAX. VALUES (FOR EACH PROC OVER ALL TIMESLOTS):'
  WRITE(NULOUT,'(10I8)') (MAXVAL(NTSLTOBP(JROC,1:NACTIM)),JROC=1,NPROC)
  NOBNTV  = SUM(NTSLNTV(1:NACTIM))
  NOBSCA  = SUM(NTSLSCA(1:NACTIM))
  NOBTOV  = SUM(NTSLTOV(1:NACTIM))
  NOBPROF = SUM(NTSLPROF(1:NACTIM))
ELSE

!*       3.2   3-D var specific   (includes CANARI)

  NTSLTOB(1) = IOBTOTPAT(MYPROC)
  NTSLPROF(1) = ITSLTPROF(MYPROC,1)
  NTSLSCA(1) = IOBSTYPAT(MYPROC,NSCATT)
  NTSLTOV(1) = IOBSTYPAT(MYPROC,NSATEM)
  NTSLNTV(1) = SUM(IOBSTYPAT(MYPROC,:),MASK=LLOBSMASK(:))
  ITOTOBS = NTSLNTV(1) + NTSLSCA(1) + NTSLTOV(1)
  IF (ITOTOBS /= NTSLTOB(1)) THEN
    WRITE(NULERR,'(A,I8,2A,I8)')&
     & ' TOTAL NUMB. OF OBS. ',NTSLTOB(1),' NOT EQUAL ',&
     & ' TO SUM OF SUBSETS ', ITOTOBS  
    CALL ABOR1('RD_OBS_BOXES: ITOTOBS /= NTSLTOB(1)')
  ENDIF
  NOBTOT  = IOBTOTPAT(MYPROC)
  NOBTOTG = IOBTOTGAT
  NOBTOTM = MAXVAL(IOBTOTPAT)
  DO JROC = 1 , NPROC
    NOBTOTP(JROC) = IOBTOTPAT(JROC)
    NTSLTOBP(JROC,1) = IOBTOTPAT(JROC)
  ENDDO
  NTSLTOBG(1) = SUM(NTSLTOBP(:,1))
  NTSLTOBM(1) = MAXVAL(NTSLTOBP(:,1))
  NOBNTV  = NTSLNTV(1)
  NOBSCA  = NTSLSCA(1)
  NOBTOV  = NTSLTOV(1)
  NOBPROF = NTSLPROF(1)
ENDIF

NOBTOVG = SUM(IOBSTYPAT(1:NPROC,NSATEM))
NOBTOVBP(:)=IOBSTYPAT(1:NPROC,NSATEM)
NOBTOVMX=MAXVAL(IOBSTYPAT(1:NPROC,NSATEM))
LTOVSCV = LTOVSCV .AND. (NOBTOVG>0)

NOBNTVG = SUM(IOBSTYPAT(1:NPROC,NSYNOP) + IOBSTYPAT(1:NPROC,NAIREP) +&
  & IOBSTYPAT(1:NPROC,NSATOB) + IOBSTYPAT(1:NPROC,NDRIBU) +&
  & IOBSTYPAT(1:NPROC,NTEMP)  + IOBSTYPAT(1:NPROC,NPILOT) +&
  & IOBSTYPAT(1:NPROC,NPAOB))

 NOBNTVBP(:)=IOBSTYPAT(1:NPROC,NSYNOP) + IOBSTYPAT(1:NPROC,NAIREP) +&
  & IOBSTYPAT(1:NPROC,NSATOB) + IOBSTYPAT(1:NPROC,NDRIBU) +&
  & IOBSTYPAT(1:NPROC,NTEMP)  + IOBSTYPAT(1:NPROC,NPILOT) +&
  & IOBSTYPAT(1:NPROC,NPAOB)

LTSCV = LTSCV .AND. (NOBNTVG>0)



IOFFTOT = 0
IOFFTOV = 0
IOFFNTV = 0
IOFFSCA = 0
DO JTS = 1 , NACTIM
  NTSLPT(JTS) = IOFFTOT
  NTSLTOBOFF(JTS) = IOFFTOT
  NTSLTOVOFF(JTS) = IOFFTOV
  NTSLNTVOFF(JTS) = IOFFNTV
  NTSLSCAOFF(JTS) = IOFFSCA
  IOFFTOT = IOFFTOT+NTSLTOB(JTS)
  IOFFTOV = IOFFTOV+NTSLTOV(JTS)
  IOFFNTV = IOFFNTV+NTSLNTV(JTS)
  IOFFSCA = IOFFSCA+NTSLSCA(JTS)
ENDDO

!     -------------------------------------------------------------------
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
8 FORMAT(1X,'ARRAY ',A10,' DEALLOCATED IN RD_OBS_BOXES ')

IF (LHOOK) CALL DR_HOOK('RD_OBS_BOXES',1,ZHOOK_HANDLE)
END SUBROUTINE RD_OBS_BOXES
