SUBROUTINE CAUPFLG(KBUFR,KDIM)

!-----------------------------------------------------------------------
!   CAUPFLG : Mise a jour du flag d'utilisation des observations dans 
!   -------   les differentes analyses en memoire distribuee

!    auteur : F. Taillefer  12/00
!-----------------------------------------------------------------------

!  ENTREES/SORTIES :
!  ------- -------
!    KBUFR : tableau des flags pour tous les parametres
!    KDIM  : dimension de KBUFR

!-----------------------------------------------------------------------

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

USE YOMMP    , ONLY : NPRCIDS  ,MYPROC
USE YOMTAG   , ONLY : MTAGGSUM
USE YOMCT0   , ONLY : NPROC
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM 
INTEGER(KIND=JPIM)               :: KBUFR(KDIM) ! UNDETERMINED INTENT
INTEGER(KIND=JPIM) :: IFLG,IFLGF,ILREC,ITAG,JP,JO,JBIT

INTEGER(KIND=JPIM) :: IBUFGL(KDIM,NPROC),IBUFL(KDIM),IBIT(NPROC)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "qabitu.h"

!-----------------------------------------------------------------------
!  - 1 -  Recuperation de tous les flags par le processeur 1
!         --------------------------------------------------

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

ITAG=MTAGGSUM+170
IF (MYPROC == 1) THEN
  IBUFGL(:,1)=KBUFR(:)
  DO JP = 2 , NPROC
    CALL MPL_RECV(IBUFL(1:KDIM),KSOURCE=NPRCIDS(JP),KTAG=ITAG, &
     & KOUNT=ILREC,CDSTRING='CAUPFLG :')
    IF (ILREC /= KDIM) CALL ABOR1('CAUPFLG 1: MESSAGE LENGTH OF WRONG SIZE')
    IBUFGL(:,JP)=IBUFL(:)
  ENDDO
ELSE
  CALL MPL_SEND(KBUFR(1:KDIM),KDEST=NPRCIDS(1),KTAG=ITAG,CDSTRING='CAUPFLG :')
ENDIF

!-----------------------------------------------------------------------
!  - 2 -  Elaboration valeur finale du flag d'utilisation
!         -----------------------------------------------

! on ne s'interesse qu'aux bits 21 a 29 pour l'analyse

IF (MYPROC == 1) THEN
  DO JO = 1 , KDIM
    DO JBIT = 21 , 29
      IFLG=0
      DO JP = 1 , NPROC
        IBIT(JP)=KBITLU(IBUFGL(JO,JP),JBIT,1)
        IFLG=IFLG+IBIT(JP)
      ENDDO
      IFLGF=MIN(1,IFLG)
      IBUFGL(JO,1)=KBIT1OU0(IBUFGL(JO,1),IFLGF,JBIT)
    ENDDO
  ENDDO
ENDIF

!-----------------------------------------------------------------------
!  - 3 -  Envoi du flag a tous les processeurs
!         ------------------------------------

ITAG=MTAGGSUM+171
IF (MYPROC == 1) THEN
  KBUFR(:)=IBUFGL(:,1)
  DO JP = 2 , NPROC
    CALL MPL_SEND(KBUFR(1:KDIM),KDEST=NPRCIDS(JP),KTAG=ITAG,CDSTRING='CAUPFLG :')
  ENDDO
ELSE
  CALL MPL_RECV(IBUFL(1:KDIM),KSOURCE=NPRCIDS(1),KTAG=ITAG,KOUNT=ILREC, &
   & CDSTRING='CAUPFLG :')  
  IF (ILREC /= KDIM) CALL ABOR1('CAUPFLG 2: MESSAGE LENGTH OF WRONG SIZE')
  KBUFR(:)=IBUFL(:)
ENDIF

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CAUPFLG',1,ZHOOK_HANDLE)
END SUBROUTINE CAUPFLG
