SUBROUTINE POST_PRSTA

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

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

!**   Interface.
!     ----------
!        *CALL* *POST_PRSTA

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

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

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

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

!     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 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 YOMCMA   , ONLY : NMXOTP
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM) :: ILIST(32),IRSTA(4),IDSTA(4)
INTEGER(KIND=JPIM) :: ITOT(5),ISUM(15)
INTEGER(KIND=JPIM),DIMENSION(:), ALLOCATABLE :: IGLO(:)

INTEGER(KIND=JPIM) :: IDIM,&
 & IPOI, &
 & J, J1, J2, JA, JO, JS, JV  

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcobs.h"

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

!*       1.      INITIALIZE
!                ----------

!*          1.1  INITIALIZE THE LOCAL ARRAYS

IF (LHOOK) CALL DR_HOOK('POST_PRSTA',0,ZHOOK_HANDLE)
ITOT(:) = 0
ISUM(:) = 0
ILIST(:) = 0
IRSTA(:) = 0
IDSTA(:) = 0

!*          1.2  INITIALIZE THE GLOBAL ARRAYS

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

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

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

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

!*          5.1   MAKE A JOINT ARRAY FOR COMMUNICATION

IDIM = SIZE(NRDBRR)  + SIZE(NRDBRD) + SIZE(NREVTOT)&
 & + SIZE(NDEVTOT) + SIZE(NDOBVA) + SIZE(NDEPEX)&
 & + SIZE(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(NRDBRR,DIM=1)
  DO J2 = 1, SIZE(NRDBRR,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NRDBRR(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NRDBRD,DIM=1)
  DO J2 = 1, SIZE(NRDBRD,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NRDBRD(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NREVTOT,DIM=1)
  DO J2 = 1, SIZE(NREVTOT,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NREVTOT(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDEVTOT,DIM=1)
  DO J2 = 1, SIZE(NDEVTOT,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NDEVTOT(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDOBVA,DIM=1)
  DO J2 = 1, SIZE(NDOBVA,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NDOBVA(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDEPEX,DIM=1)
  DO J2 = 1, SIZE(NDEPEX,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NDEPEX(J1,J2)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDEPNE,DIM=1)
  DO J2 = 1, SIZE(NDEPNE,DIM=2)
    IPOI = IPOI + 1
    IGLO(IPOI) = NDEPNE(J1,J2)
  ENDDO
ENDDO

!*          5.2   TAKE A GLOBAL SUM OF ARRAY ELEMENTS

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

!*          5.3   GO BACK TO INDIVIDUAL ARRAYS FROM THE JOINT

IPOI = 0
DO J1 = 1, SIZE(NRDBRR,DIM=1)
  DO J2 = 1, SIZE(NRDBRR,DIM=2)
    IPOI = IPOI + 1
    NRDBRR(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NRDBRD,DIM=1)
  DO J2 = 1, SIZE(NRDBRD,DIM=2)
    IPOI = IPOI + 1
    NRDBRD(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NREVTOT,DIM=1)
  DO J2 = 1, SIZE(NREVTOT,DIM=2)
    IPOI = IPOI + 1
    NREVTOT(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDEVTOT,DIM=1)
  DO J2 = 1, SIZE(NDEVTOT,DIM=2)
    IPOI = IPOI + 1
    NDEVTOT(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDOBVA,DIM=1)
  DO J2 = 1, SIZE(NDOBVA,DIM=2)
    IPOI = IPOI + 1
    NDOBVA(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDEPEX,DIM=1)
  DO J2 = 1, SIZE(NDEPEX,DIM=2)
    IPOI = IPOI + 1
    NDEPEX(J1,J2) = IGLO(IPOI)
  ENDDO
ENDDO
DO J1 = 1, SIZE(NDEPNE,DIM=1)
  DO J2 = 1, SIZE(NDEPNE,DIM=2)
    IPOI = IPOI + 1
    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,*)
WRITE(NULOUT,FMT='(" *** SCREENING STATISTICS ")')
WRITE(NULOUT,FMT='("     -------------------- ",/)')
WRITE(NULOUT,FMT='(" *** FOR WHOLE OBSERVATION ARRAY ",/)')
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,NRDBRR(JO,5),(NRDBRR(JO,JS),JS=1,4)  
  DO J =  1,5
    ITOT(J) = ITOT(J) + 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,NRDBRD(JO,5),(NRDBRD(JO,JS),JS=1,4)  
  DO JA =  1,5
    ITOT(JA) = ITOT(JA) + 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,*)

!*          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,(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,(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=*)

!*          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(NDOBVA(:,JO)) > 0 )THEN
    WRITE(NULOUT,FMT='(3X,I4,3X,15(1X,I10))')JO,(NDOBVA(JV,JO),JV=1,NMXOTP)
    DO JV = 1, NMXOTP 
      ISUM(JV) = ISUM(JV) + 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(NDEPEX(:,JO)) > 0 )THEN
    WRITE(NULOUT,FMT='(3X,I4,3X,15(1X,I10))')JO,(NDEPEX(JV,JO),JV=1,NMXOTP)
    DO JV = 1, NMXOTP 
      ISUM(JV) = ISUM(JV) + 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(NDEPNE(:,JO)) > 0 )THEN
    WRITE(NULOUT,FMT='(3X,I4,3X,15(1X,I10))')JO,(NDEPNE(JV,JO),JV=1,NMXOTP)
    DO JV = 1, NMXOTP 
      ISUM(JV) = ISUM(JV) + 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('POST_PRSTA',1,ZHOOK_HANDLE)
END SUBROUTINE POST_PRSTA
