SUBROUTINE PRSTA(KSLOT,LDLAST,KLEN)

!**** *PRSTA*  -  Collect and print ifs observation screening statistics

!     Purpose.
!     --------
!           Collect and print ifs observation screening statistics.

!**   Interface.
!     ----------
!        *CALL* *PRSTA

!        Explicit arguments : None
!        --------------------

!        Implicit arguments : None
!        --------------------
!        None

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!        GERSTA - GET REPORT STATUS
!        GEREVE - GET REPORT EVENTS
!        GEDSTA - GET DATUM STATUS
!        GEDEVE - GET DATUM EVENTS

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Heikki Jarvinen *ECMWF*

!     Modifications.
!     --------------
!        Original : 95-03-15
!        Modified : 
!        Elias Holm 20001009    : Use maximum variable number NVNUMAX for
!                                 dimensioning NDOBVA, NDEPEX, and NDEPNE
!        Sami Saarinen 20030625 : Changed FORMATs to accomodate larger amounts of data
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     --------------------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMANCS  , ONLY : RMDI     
USE YOMSCREE , ONLY : NRDBRR   ,NRDBRD   ,&
 & NREVTOT  ,NDEVTOT  ,NDOBVA   ,NDEPEX   ,&
 & NDEPNE
USE YOMNMEV  , ONLY : NOREV1   ,NODEV1
USE YOMCHEV  , ONLY : CR1EVENT ,CH1EVENT
USE YOMMP    , ONLY : MYPROC
USE YOMDB
USE YOMSCC   , ONLY : LSCDPR
USE YOMVNMB  , ONLY : NVNUMAX
USE MPL_MODULE
USE OML_MOD, ONLY : OML_MY_THREAD
USE YOMCMA, ONLY : NMXOTP

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSLOT 
LOGICAL           ,INTENT(IN)    :: LDLAST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM) :: ILIST(32),IRSTA(4),IDSTA(4)
INTEGER(KIND=JPIM) :: IRFL(5),IDFL(2),ITOT(5),ISUM(15)
INTEGER(KIND=JPIM),DIMENSION(:), ALLOCATABLE :: IGLO(:)

INTEGER(KIND=JPIM) :: &
     & I_NRDBRR (SIZE(NRDBRR ,DIM=1),SIZE(NRDBRR ,DIM=2)), &
     & I_NREVTOT(SIZE(NREVTOT,DIM=1),SIZE(NREVTOT,DIM=2)), &
     & I_NRDBRD (SIZE(NRDBRD ,DIM=1),SIZE(NRDBRD ,DIM=2)), &
     & I_NDEVTOT(SIZE(NDEVTOT,DIM=1),SIZE(NDEVTOT,DIM=2)), &
     & I_NDOBVA (SIZE(NDOBVA ,DIM=1),SIZE(NDOBVA ,DIM=2)), &
     & I_NDEPNE (SIZE(NDEPNE ,DIM=1),SIZE(NDEPNE ,DIM=2)), &
     & I_NDEPEX (SIZE(NDEPEX ,DIM=1),SIZE(NDEPEX ,DIM=2))

INTEGER(KIND=JPIM) :: ICMVNM, ICOUNT, IDIM,&
 & IEVENT, ILEV, IOBTYP, IPOI, &
 & J, J1, J2, JA, JNLV, JO, JOBS, JS, JV, ILEN 

REAL(KIND=JPRB) :: ZCMOMF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "ngedeve.intfb.h"
#include "ngedsta.intfb.h"
#include "ngereve.intfb.h"
#include "ngersta.intfb.h"

#include "fcobs.h"

#include "openmp_obs.h"
!*
!     ------------------------------------------------------------------
!*       1.      INITIALIZE
!                ----------

!*          1.1  INITIALIZE THE LOCAL ARRAYS

IF (LHOOK) CALL DR_HOOK('PRSTA',0,ZHOOK_HANDLE)

IRFL(:) = 0
IDFL(:) = 0
ITOT(:) = 0
ISUM(:) = 0
ILIST(:) = 0
IRSTA(:) = 0
IDSTA(:) = 0

!*          1.2  INITIALIZE THE GLOBAL ARRAYS

I_NRDBRR (:,:) = 0
I_NREVTOT(:,:) = 0
I_NRDBRD (:,:) = 0
I_NDEVTOT(:,:) = 0
I_NDOBVA (:,:) = 0
I_NDEPNE (:,:) = 0
I_NDEPEX (:,:) = 0
!*
!     ------------------------------------------------------------------

!*       2.       COLLECT THE SCREENING INFORMATION
!                 ---------------------------------

ILEN = KLEN

!*          2.2   LOOP OVER THE OBSERVATIONS

OBS_LOOP: DO JOBS = 1, ILEN

  IOBTYP = ROBHDR(JOBS,MDBOTP)

!*          2.4   GET REPORT STATUS

  CALL NGERSTA(INT(ROBHDR(JOBS,MDBRST)),ICOUNT,IRSTA)

!*          2.5   COUNT FOR ACTIVE/PASSIVE/REJECTED/BLACKLISTED

  IF(IRSTA(1) == 1) I_NRDBRR(IOBTYP,1) = I_NRDBRR(IOBTYP,1) + 1
  IF(IRSTA(2) == 1) I_NRDBRR(IOBTYP,2) = I_NRDBRR(IOBTYP,2) + 1
  IF(IRSTA(3) == 1) I_NRDBRR(IOBTYP,3) = I_NRDBRR(IOBTYP,3) + 1
  IF(IRSTA(4) == 1) I_NRDBRR(IOBTYP,4) = I_NRDBRR(IOBTYP,4) + 1

!*          2.6   COUNT FOR THE REPORTS

  I_NRDBRR(IOBTYP,5) = I_NRDBRR(IOBTYP,5) + 1

!*          2.7   GET REPORT EVENTS

  CALL NGEREVE(INT(ROBHDR(JOBS,MDBREV1)),IEVENT,ILIST)

!*          2.8   COLLECT REPORT EVENTS OF DIFFERENT OBS.TYPES

  IF(IEVENT /= 0) THEN
    DO JO = 1, NOREV1
      IF(ILIST(JO) == 1) THEN
        I_NREVTOT(IOBTYP,JO) = I_NREVTOT(IOBTYP,JO)+1
      ENDIF
    ENDDO
  ENDIF
!*
!     ------------------------------------------------------------------

!*       3.       LOOP OVER THE REPORT, DATUM BY DATUM
!                 ------------------------------------

  REP_LOOP: DO JNLV = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
    ILEV = JNLV

!*          3.1   GET DATUM STATUS

    CALL NGEDSTA(INT(ROBODY(JNLV,MDBDSTA)),ICOUNT,IDSTA)

!*          3.2   COUNT FOR ACTIVE/PASSIVE/REJECTED/BLACKLISTED

    IF(IDSTA(1) == 1) I_NRDBRD(IOBTYP,1) = I_NRDBRD(IOBTYP,1) + 1
    IF(IDSTA(2) == 1) I_NRDBRD(IOBTYP,2) = I_NRDBRD(IOBTYP,2) + 1
    IF(IDSTA(3) == 1) I_NRDBRD(IOBTYP,3) = I_NRDBRD(IOBTYP,3) + 1
    IF(IDSTA(4) == 1) I_NRDBRD(IOBTYP,4) = I_NRDBRD(IOBTYP,4) + 1

!*          3.3   COUNT FOR THE DATA IN OBSERVATION TYPES

    I_NRDBRD(IOBTYP,5) = I_NRDBRD(IOBTYP,5) + 1

!*          3.4   COUNT FOR DATA IN OBSERVATION TYPES/VARIABLES

    ICMVNM = ROBODY(ILEV,MDBVNM)
        
    I_NDOBVA(IOBTYP,ICMVNM) = I_NDOBVA(IOBTYP,ICMVNM) + 1

!*             3.4.1   FIRST GUESS DEPARTURE EXIST/NONEXIST

    ZCMOMF = ROBODY(ILEV,MDBOMF)
    IF(ZCMOMF == RMDI) THEN
      I_NDEPNE(IOBTYP,ICMVNM) = I_NDEPNE(IOBTYP,ICMVNM) + 1
    ELSE
      I_NDEPEX(IOBTYP,ICMVNM) = I_NDEPEX(IOBTYP,ICMVNM) + 1
    ENDIF

!*          3.5   GET DATUM EVENTS

    CALL NGEDEVE(INT(ROBODY(ILEV,MDBDEV1)),IEVENT,ILIST)

!*          3.6   COUNT FOR DATUM EVENTS IN DIFFERENT OBS.TYPES

    IF(IEVENT /= 0) THEN
      DO JO = 1, NODEV1
        IF(ILIST(JO) == 1) THEN
          I_NDEVTOT(IOBTYP,JO) = I_NDEVTOT(IOBTYP,JO)+1
        ENDIF
      ENDDO
    ENDIF
!*
!     ------------------------------------------------------------------

!*       4.        CLOSE THE LOOP OVER ...
!                  -----------------------
!*
!           4.1    ... THE REPORT

  ENDDO REP_LOOP
!*
!           4.2    ... THE OBSERVATION

ENDDO OBS_LOOP

!*
!     ------------------------------------------------------------------

!*       5.        PRINT OUT THE COLLECTED INFORMATION
!                  -----------------------------------

!*          5.1   MAKE A JOINT ARRAY FOR COMMUNICATION

IDIM = SIZE(I_NRDBRR)  + SIZE(I_NRDBRD) + SIZE(I_NREVTOT)&
 & + SIZE(I_NDEVTOT) + SIZE(I_NDOBVA) + SIZE(I_NDEPEX)&
 & + SIZE(I_NDEPNE)  

ALLOCATE (IGLO(IDIM))
IF(LSCDPR) THEN
  WRITE(NULOUT,9990) 'IGLO   ',SIZE(IGLO   ),SHAPE(IGLO   )
ENDIF
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

IPOI = 0
IGLO(:) = 0
DO J1 = 1, SIZE(I_NRDBRR,DIM=1)
  DO J2 = 1, SIZE(I_NRDBRR,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NRDBRR(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NRDBRD,DIM=1)
  DO J2 = 1, SIZE(I_NRDBRD,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NRDBRD(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NREVTOT,DIM=1)
  DO J2 = 1, SIZE(I_NREVTOT,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NREVTOT(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDEVTOT,DIM=1)
  DO J2 = 1, SIZE(I_NDEVTOT,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NDEVTOT(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDOBVA,DIM=1)
  DO J2 = 1, SIZE(I_NDOBVA,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NDOBVA(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDEPEX,DIM=1)
  DO J2 = 1, SIZE(I_NDEPEX,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NDEPEX(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDEPNE,DIM=1)
  DO J2 = 1, SIZE(I_NDEPNE,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = I_NDEPNE(J1,J2)
  ENDDO
ENDDO

!*          5.2   TAKE A GLOBAL SUM OF ARRAY ELEMENTS

CALL MPL_ALLREDUCE(IGLO, 'SUM',CDSTRING='PRSTA:')

!*          5.3   GO BACK TO INDIVIDUAL ARRAYS FROM THE JOINT

IPOI = 0
DO J1 = 1, SIZE(I_NRDBRR,DIM=1)
  DO J2 = 1, SIZE(I_NRDBRR,DIM=2)
    IPOI = IPOI + 1
    I_NRDBRR(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NRDBRD,DIM=1)
  DO J2 = 1, SIZE(I_NRDBRD,DIM=2)
    IPOI = IPOI + 1
    I_NRDBRD(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NREVTOT,DIM=1)
  DO J2 = 1, SIZE(I_NREVTOT,DIM=2)
    IPOI = IPOI + 1
    I_NREVTOT(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDEVTOT,DIM=1)
  DO J2 = 1, SIZE(I_NDEVTOT,DIM=2)
    IPOI = IPOI + 1
    I_NDEVTOT(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDOBVA,DIM=1)
  DO J2 = 1, SIZE(I_NDOBVA,DIM=2)
    IPOI = IPOI + 1
    I_NDOBVA(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDEPEX,DIM=1)
  DO J2 = 1, SIZE(I_NDEPEX,DIM=2)
    IPOI = IPOI + 1
    I_NDEPEX(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(I_NDEPNE,DIM=1)
  DO J2 = 1, SIZE(I_NDEPNE,DIM=2)
    IPOI = IPOI + 1
    I_NDEPNE(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO

!*          5.5    PRINT REPORT STATISTICS

IF(MYPROC /= 1) GOTO 6
DO JO = 1,5
  ITOT(JO) = 0
ENDDO
WRITE(NULOUT,*)
IF(LDLAST) THEN
  WRITE(NULOUT,FMT='(" *** SCREENING STATISTICS ")')
  WRITE(NULOUT,FMT='("     -------------------- ")')
  WRITE(NULOUT,FMT='(" *** FOR WHOLE OBSERVATION ARRAY ",/)')
ELSE
  WRITE(NULOUT,FMT='(" *** SCREENING STATISTICS FOR TIMESLOT ",I3,/)') KSLOT
ENDIF
WRITE(NULOUT,FMT='(" STATUS SUMMARY OF REPORTS: ",/)')
WRITE(NULOUT,FMT='("  OB.TYP",5(1X,A12))')&
 & 'REPORTS','ACTIVE','PASSIVE','REJECTED','BLACKLISTED'  
DO JO =  1,NMXOTP
  WRITE(NULOUT,FMT='(5X,I3,5(1X,I12))')&
   & JO,I_NRDBRR(JO,5),(I_NRDBRR(JO,JS),JS=1,4)  
  DO J =  1,5
    ITOT(J) = ITOT(J) + I_NRDBRR(JO,J)
  ENDDO
ENDDO
WRITE(NULOUT,FMT='(5X,68("-"))')
WRITE(NULOUT,FMT='(5X,"TOT",5(1X,I12))')&
 & ITOT(5),(ITOT(J),J=1,4)  
WRITE(NULOUT,*)

!*          5.6    PRINT DATUM STATISTICS

DO JO = 1,5
  ITOT(JO) = 0
ENDDO
WRITE(NULOUT,FMT='(" STATUS SUMMARY OF DATA: ",/)')
WRITE(NULOUT,FMT='("  OB.TYP",5(1X,A12))')&
 & 'REPORTS','ACTIVE','PASSIVE','REJECTED','BLACKLISTED'  
DO JO =  1,NMXOTP
  WRITE(NULOUT,FMT='(5X,I3,5(1X,I12))')&
   & JO,I_NRDBRD(JO,5),(I_NRDBRD(JO,JS),JS=1,4)  
  DO JA =  1,5
    ITOT(JA) = ITOT(JA) + I_NRDBRD(JO,JA)
  ENDDO
ENDDO
WRITE(NULOUT,FMT='(5X,68("-"))')
WRITE(NULOUT,FMT='(5X,"TOT",5(1X,I12))')&
 & ITOT(5),(ITOT(JS),JS=1,4)  
WRITE(NULOUT,*)

!IF(.NOT.LDLAST) GOTO 6

!*          5.7   PRINT REPORT EVENTS

WRITE(NULOUT,FMT='(" EVENT SUMMARY OF REPORTS: ",/)')
WRITE(NULOUT,FMT='("   OB.TYP:",(15(1X,I10)))') (JV,JV=1,NMXOTP)
WRITE(NULOUT,FMT='(" EVENT ")')
DO JO =  1, NOREV1
  WRITE(NULOUT,FMT='(4X,I2,4X,15(1X,I10))')JO,(I_NREVTOT(JV,JO),JV=1,NMXOTP)
ENDDO
WRITE(NULOUT,FMT=*)
DO JO =  1, NOREV1
  WRITE(NULOUT,FMT='(4X,A)') CR1EVENT(JO)
ENDDO
WRITE(NULOUT,FMT=*)

!*          5.8   PRINT DATUM EVENTS

WRITE(NULOUT,FMT='(" EVENT SUMMARY OF DATA: ",/)')
WRITE(NULOUT,FMT='("   OB.TYP:",(15(1X,I10)))') (JV,JV=1,NMXOTP)
WRITE(NULOUT,FMT='(" EVENT ")')
DO JO =  1, NODEV1
  WRITE(NULOUT,FMT='(4X,I2,4X,15(1X,I10))')JO,(I_NDEVTOT(JV,JO),JV=1,NMXOTP)
ENDDO
WRITE(NULOUT,FMT=*)
DO JO =  1, NODEV1
  WRITE(NULOUT,FMT='(4X,A)') CH1EVENT(JO)
ENDDO
WRITE(NULOUT,FMT=*)

IF(.NOT.LDLAST) GOTO 6
!*          5.9   PRINT NUMBER OF VARIABLES IN DIFFERENT OBS.TYPES

ISUM(:) = 0
WRITE(NULOUT,FMT='(" NUMBER OF VARIABLES IN DIFFERENT OBSERVATION TYPES: ",/)')
WRITE(NULOUT,FMT='("   OB.TYP:",(15(1X,I10)))') (JV,JV=1,NMXOTP)
WRITE(NULOUT,FMT='(" VARIAB ")')
DO JO =  1, NVNUMAX
  IF(MAXVAL(I_NDOBVA(:,JO)) > 0 )THEN
    WRITE(NULOUT,FMT='(3X,I4,3X,15(1X,I10))')JO,(I_NDOBVA(JV,JO),JV=1,NMXOTP)
    DO JV = 1, NMXOTP 
      ISUM(JV) = ISUM(JV) + I_NDOBVA(JV,JO)
    ENDDO
  ENDIF
ENDDO
WRITE(NULOUT,FMT='(4X,116("-"))')
WRITE(NULOUT,FMT='(4X,"TOT",3X,15(1X,I10))')(ISUM(JV),JV=1,NMXOTP)
WRITE(NULOUT,FMT=*)

!*          5.10  PRINT NUMBER OF DEPARTURES IN DIFFERENT OBS.TYPES

ISUM(:) = 0
WRITE(NULOUT,FMT='(" NUMBER OF DEPARTURES IN DIFFERENT OBSERVATION TYPES: ",/)')
WRITE(NULOUT,FMT='("   OB.TYP:",(15(1X,I10)))') (JV,JV=1,NMXOTP)
WRITE(NULOUT,FMT='(" VARIAB ")')
DO JO =  1, NVNUMAX
  IF(MAXVAL(I_NDEPEX(:,JO)) > 0 )THEN
    WRITE(NULOUT,FMT='(3X,I4,3X,15(1X,I10))')JO,(I_NDEPEX(JV,JO),JV=1,NMXOTP)
    DO JV = 1,NMXOTP 
      ISUM(JV) = ISUM(JV) + I_NDEPEX(JV,JO)
    ENDDO
  ENDIF
ENDDO
WRITE(NULOUT,FMT='(4X,116("-"))')
WRITE(NULOUT,FMT='(4X,"TOT",3X,15(1X,I10))')(ISUM(JV),JV=1,NMXOTP)
WRITE(NULOUT,FMT=*)

!*          5.11  PRINT NUMBER OF MISSING DEPS. IN DIFFERENT OBS.TYPES

ISUM(:) = 0
WRITE(NULOUT,FMT='(" NUMBER OF MISSING DEPARTURES IN DIFFERENT OBSERVATION TYPES: ",/)')
WRITE(NULOUT,FMT='("   OB.TYP:",(15(1X,I10)))') (JV,JV=1,NMXOTP)
WRITE(NULOUT,FMT='(" VARIAB ")')
DO JO =  1, NVNUMAX
  IF(MAXVAL(I_NDEPNE(:,JO)) > 0 )THEN
    WRITE(NULOUT,FMT='(3X,I4,3X,15(1X,I10))')JO,(I_NDEPNE(JV,JO),JV=1,NMXOTP)
    DO JV = 1, 10
      ISUM(JV) = ISUM(JV) + I_NDEPNE(JV,JO)
    ENDDO
  ENDIF
ENDDO
WRITE(NULOUT,FMT='(4X,116("-"))')
WRITE(NULOUT,FMT='(4X,"TOT",3X,15(1X,I10))')(ISUM(JV),JV=1,NMXOTP)
WRITE(NULOUT,FMT=*)


!*
!     ------------------------------------------------------------------

!*       6.    RETURN
!              ------

6 CONTINUE
IF(ALLOCATED (IGLO)) DEALLOCATE (IGLO)

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