MODULE varbc_pred
!-----------------------------------------------------------------------
!   VARBC_PRED - Predictors for variational bias correction

!   Purpose. 
!   --------
!   Definition, evaluation, statistics of predictors used by VarBC

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/10/01
!   G. Mozdzynski 03-Jun-2009 VarBC reproducibility rework
!   10-Jun-2008  Alan Geer   Calculate predictor covariances by obgroup
!   26-Feb-2010  T. Wilhelmsson  More VarBC reproducibility rework
!------------------------------------------------------------------------

USE parkind1  , ONLY : JPIM, JPRB
USE yomhook   , ONLY : LHOOK, DR_HOOK
USE yomct0    , ONLY : LIFSTRAJ
USE yomobset  , ONLY : MLNSET, NSETOT
USE yomancs   , ONLY : RMDI, RDEGREES 
USE yomcst    , ONLY : RG, RPI
USE yomvar    , ONLY : LREPRO4DVAR
USE yomlun    , ONLY : NULOUT
USE mpl_module, ONLY : MPL_ALLREDUCE
USE varbc_table, ONLY : NOBGROUP, JPMXNGROUP
USE order_independent_summation_mod , ONLY : ORDER_INDEP_GLOBAL_SUM2

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

IMPLICIT NONE
SAVE

PRIVATE
PUBLIC varbc_pred_rad, varbc_pred_to3, varbc_pred_airep, varbc_pred_stats
PUBLIC jpmxnpred, npredcs_rad, npredcs_to3, npredcs_airep
PUBLIC mpredxcnt, apredmean, apredxcov
PUBLIC nmixbuf_len, nmixbuf_cnt, napredbuf_len, napredbuf_cnt, mixbuf, apredbuf

INTERFACE varbc_pred_rad
  MODULE PROCEDURE predictors_rad
END INTERFACE varbc_pred_rad

INTERFACE varbc_pred_to3
  MODULE PROCEDURE predictors_to3
END INTERFACE varbc_pred_to3

INTERFACE varbc_pred_airep
  MODULE PROCEDURE predictors_airep
END INTERFACE varbc_pred_airep

INTERFACE varbc_pred_stats
  MODULE PROCEDURE print_stats
END INTERFACE varbc_pred_stats


CHARACTER(LEN=*), PARAMETER :: modname = 'VarBC_pred'

! Predictor information:
! ---------------------
!   jpmxnpred     predictors are indexed from 0 to jpmxnpred
!   cpreddesc     predictor descriptions (for printing)
!   pprednorm     predictor normalization: global mean, stdv

INTEGER(KIND=JPIM), PARAMETER :: jpmxnpred = 18
CHARACTER(LEN=21),  PARAMETER :: cpreddesc(0:jpmxnpred) = &
                               & (/ '1 (constant)         ', &
                               &    '1000-300hPa thickness', &
                               &    '200-50hPa thickness  ', &
                               &    'T_skin               ', &
                               &    'total column water   ', &
                               &    '10-1hPa thickness    ', &
                               &    '50-5hPa thickness    ', &
                               &    'surface wind speed   ', &
                               &    'nadir viewing angle  ', &
                               &    'nadir view angle **2 ', &
                               &    'nadir view angle **3 ', &
                               &    'nadir view angle **4 ', &
                               &    'cos solar zen angle  ', &
                               &    'solar elevation      ', &
                               &    'TMI diurnal bias     ', &
                               &    'land or sea ice mask ', &
                               &    'view angle (land)    ', &
                               &    'view angle **2 (land)', &
                               &    'view angle **3 (land)' /)
REAL(KIND=JPRB),    PARAMETER :: pprednorm(2,0:jpmxnpred) = &
                               & RESHAPE(                           &
                               & (/     1.0_JPRB,       0.0_JPRB,   &
                               &     9207.0_JPRB,     446.0_JPRB,   &
                               &     8491.0_JPRB,     387.0_JPRB,   & 
                               &      285.0_JPRB,      20.5_JPRB,   &
                               &       25.0_JPRB,      17.8_JPRB,   &
                               &    16622.0_JPRB,     374.0_JPRB,   &
                               &    14975.0_JPRB,     570.0_JPRB,   &
                               &        6.0_JPRB,       3.6_JPRB,   &
                               &        5.5_JPRB,      28.7_JPRB,   &
                               &      853.0_JPRB,     744.0_JPRB,   &
                               &     9300.0_JPRB,   46700.0_JPRB,   &
                               &  1540000.0_JPRB, 2799000.0_JPRB,   &
                               &        0.0_JPRB,       0.3_JPRB,   &
                               &      -12.0_JPRB,      40.0_JPRB,   &
                               &        0.0_JPRB,       1.0_JPRB,   &
                               &        0.0_JPRB,       1.0_JPRB,   &
                               &        5.5_JPRB,      28.7_JPRB,   &
                               &      853.0_JPRB,     744.0_JPRB,   &
                               &     9300.0_JPRB,   46700.0_JPRB /),&
                               & (/ 2, jpmxnpred+1 /) )

! Lists of available predictors by data type
! ------------------------------------------
INTEGER(KIND=JPIM), PARAMETER :: npredcs_rad  (18) = (/0,1,2,3,4,5,6,7,8,9,10,11,12,   14,15,16,17,18/)
INTEGER(KIND=JPIM), PARAMETER :: npredcs_to3  ( 2) = (/0,                           13               /)
INTEGER(KIND=JPIM), PARAMETER :: npredcs_airep( 1) = (/0                                             /)

! Arrays for computing predictor statistics
! -----------------------------------------
INTEGER(KIND=JPIM) :: mpredxcnt(0:jpmxnpred,0:jpmxnpred,1:jpmxngroup)
REAL(KIND=JPRB)    :: apredmean(0:jpmxnpred,1:jpmxngroup)
REAL(KIND=JPRB)    :: apredxcov(0:jpmxnpred,0:jpmxnpred,1:jpmxngroup)

! Extra arrays for computing reproducible predictor statistics
! ------------------------------------------------------------
INTEGER(KIND=JPIM) :: nmixbuf_len, nmixbuf_cnt, napredbuf_len, napredbuf_cnt
INTEGER(KIND=JPIM), ALLOCATABLE :: mixbuf(:)
REAL(KIND=JPRB),    ALLOCATABLE :: apredbuf(:)

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

#include "abor1.intfb.h"

! ========
CONTAINS
! ========

SUBROUTINE predictors_rad (kdlen, klen, kbdlen, kcount, kix, ppres, &
                         & pzpp5, pqpp5, pls5, pci5, &
                         & pts5, pus5,  pvs5, pnvang, psolzeang, &
                         & psolhour, klev,  knpred, pred, lstats)
!-----------------------------------------------------------------------
!   PREDICTORS_RAD - Radiance bias predictors

!   Purpose. 
!   --------
!   Calculates radiance bias predictors and accumulates statistics

!   Interface.
!   ----------
!
!   Input arguments: 
!      kdlen  = maximum number of obs (profiles)
!      klen   = actual number of obs (profiles)
!      kbdlen = maximum number of body entries
!      kcount = actual number of body entries
!      kix    = VarBC obs group ID for each obs
!      ppres  = pressure levels
!      pzpp5  = model geopotential
!      pqpp5  = model humidities
!      pts5   = model surface temperatures
!      pus5   = model surface u-wind
!      pvs5   = model surface v-wind
!      pnvang = satellite nadir viewing angle
!      psolzeang = solar zenith angle at observation point
!      psolhour = fractional solar hour at observation point
!      klev   = number of pressure levels
!      knpred = number of predictors required
!      lstats = accumulate predictor statistics
!   Output arguments:
!      pred   = bias predictors 

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2004/03/19
!      P.Burton : 29-09-04 LVARBC cleanup & OpenMP bit-reprod fix.
!      T.Auligne: 09-12-05 Added Nadir viewing angle (and powers) 
!                             for scan component of the bias
!      D.Dee    : 2008/03/01 Moved to this module
!      A.Geer   : 03-Oct-2008 Solar zenith angle is now input, rather than 
!                             directly read from ODB.
!      A.Geer   : 03-Dec-2008 Calculate a TMI diurnal bias correction
!      B.Krzeminski: 16-Feb-2008 added new predictors for AMSU-A over land
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM),INTENT(IN)  :: kdlen 
INTEGER(KIND=JPIM),INTENT(IN)  :: klen 
INTEGER(KIND=JPIM),INTENT(IN)  :: kbdlen 
INTEGER(KIND=JPIM),INTENT(IN)  :: kcount(klen) 
INTEGER(KIND=JPIM),INTENT(IN)  :: klev 
INTEGER(KIND=JPIM),INTENT(IN)  :: knpred 
INTEGER(KIND=JPIM),INTENT(IN)  :: kix(kbdlen,klen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: ppres(kdlen,klev) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pzpp5(kdlen,klev) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pqpp5(kdlen,klev) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pls5(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pci5(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pts5(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pus5(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pvs5(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: pnvang(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: psolzeang(kdlen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: psolhour(kdlen) 
LOGICAL           ,INTENT(IN)  :: lstats
REAL(KIND=JPRB)   ,INTENT(OUT) :: pred(0:knpred,klen) 

REAL(KIND=JPRB), ALLOCATABLE :: zq(:)   ! model specific humidity profile
REAL(KIND=JPRB), ALLOCATABLE :: zp(:)   ! pressure levels
REAL(KIND=JPRB), ALLOCATABLE :: zlp(:)  ! log pressure levels
REAL(KIND=JPRB), ALLOCATABLE :: zdp(:)  ! delta pressure

! Required pressure levels
REAL(KIND=JPRB), PARAMETER   :: zplev(7)=(/1.0_JPRB,   5.0_JPRB,   10.0_JPRB,&
 &                  50.0_JPRB,200.0_JPRB,300.0_JPRB,1000.0_JPRB/)*100.0_JPRB

! Etc.

REAL(KIND=JPRB)    :: zts ! model skin temperature
REAL(KIND=JPRB)    :: zws ! model surface wind speed
REAL(KIND=JPRB)    :: znvang ! satellite nadir viewing angle
REAL(KIND=JPRB)    :: zw1, zw2
REAL(KIND=JPRB)    :: zzlev(SIZE(zplev))
REAL(KIND=JPRB)    :: zlplev(SIZE(zplev))

INTEGER(KIND=JPIM) :: ilev
INTEGER(KIND=JPIM) :: i, ipf, j
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (predictors_rad)'

IF (lhook) CALL DR_HOOK(myname,0,zhook_handle)

IF (knpred>jpmxnpred) CALL ABOR1(myname//': Requesting unsupported predictors')

! ------------------------------------------------------
! pred(0,:) -  1 (constant)
! pred(1,:) -  1000-300 thickness
! pred(2,:) -  200-50 thickness
! pred(3,:) -  T_skin
! pred(4,:) -  total column precipitable water
! pred(5,:) -  Stratosphere 1
! pred(6,:) -  Stratosphere 2
! pred(7,:) -  surface wind speed
! pred(8,:) -  satellite nadir viewing angle
! pred(9,:) -  satellite nadir viewing angle **2
! pred(10,:)-  satellite nadir viewing angle **3
! pred(11,:)-  satellite nadir viewing angle **4
! pred(12,:)-  cosine solar zenith angle
! pred(14,:)-  TMI diurnal bias
! pred(15,:)-  0 over sea, 1 over land
! predictor(16,:) - 0 over sea, nadir viewing angle over land
! predictor(17,:) - 0 over sea, nadir viewing angle **2  over land
! predictor(18,:) - 0 over sea, nadir viewing angle **3  over land

ALLOCATE (zq(klev), zp(klev), zlp(klev), zdp(klev-1))

pred(:,:) = RMDI
pred(0,:) = 1.0_JPRB
zlplev = LOG(zplev)

DO ipf = 1, klen

  zp (1:klev) = ppres(ipf,1:klev)  ! [Pa]
  zlp(1:klev) = log(ppres(ipf,1:klev))
  zq (1:klev) = pqpp5(ipf,1:klev)
  zts = pts5(ipf)
  zws = SQRT(pus5(ipf)*pus5(ipf) + pvs5(ipf)*pvs5(ipf))
  znvang = pnvang(ipf)

  ! Interpolate geopotential to required levels
  ! (also extrapolates linearly if requested level below the surface,
  ! e.g., for z1000)
  DO j = 1, SIZE(zplev)
    ilev = klev
    DO i = klev-1, 1, -1
      IF (zp(i) > zplev(j)) THEN
        ilev = i
      ELSE
        EXIT
      ENDIF
    ENDDO
    zw1 = (zlplev(j)-zlp(ilev-1))/(zlp(ilev)-zlp(ilev-1))
    zw2 = 1.0_JPRB-zw1
    zzlev(j) = zw1*pzpp5(ipf,ilev) + zw2*pzpp5(ipf,ilev-1)
  ENDDO

  zdp(1:klev-1) = zp(2:klev) - zp(1:klev-1)

  pred(1,ipf) = (zzlev(6)-zzlev(7))/RG   ! 1000-300 hPa
  pred(2,ipf) = (zzlev(4)-zzlev(5))/RG   ! 200-50 hPa
  pred(3,ipf) = zts
  pred(4,ipf) = 0.5*SUM((zq(2:klev)+zq(1:klev-1))*zdp(1:klev-1))/RG
! "Total column equivalent total water vapour"
! This approximates what was done when predictors were calculated
! on RTTOV levels, ie hold q constant below the surface.
  IF (zp(klev) < 101325.0_JPRB) THEN
    pred(4,ipf) = pred(4,ipf) + zq(klev)*(101325.0_JPRB - zp(klev))/RG
  ENDIF
  pred(5,ipf) = (zzlev(1)-zzlev(3))/RG   ! 1-10 hPa
  pred(6,ipf) = (zzlev(2)-zzlev(4))/RG   ! 5-50 hPa
  pred(7,ipf) = zws
  IF (znvang /= RMDI)THEN
    pred(8,ipf) = znvang
    pred(9,ipf) = znvang**2
    pred(10,ipf)= znvang**3
    pred(11,ipf)= znvang**4
    pred(15,ipf)= MAX(pls5(ipf),pci5(ipf))
    pred(16,ipf)= MAX(pls5(ipf),pci5(ipf)) * znvang
    pred(17,ipf)= MAX(pls5(ipf),pci5(ipf)) * znvang**2
    pred(18,ipf)= MAX(pls5(ipf),pci5(ipf)) * znvang**3
  ENDIF
  IF (psolzeang(ipf) /= RMDI)THEN
    IF(psolzeang(ipf) < 90._JPRB .AND. psolzeang(ipf) > -90._JPRB)THEN
      pred(12,ipf) = COS(psolzeang(ipf) / RDEGREES)
    ELSE
      pred(12,ipf) = 0.0_JPRB
    ENDIF
  ENDIF

  ! Approximate functional form of the TMI bias dependence on solar hour
  ! See Geer(2008), Satellite Section internal memo R43.8/AG/08108  
  pred(14,ipf) = cos( RPI * (psolhour(ipf)/12.0_JPRB + 0.6_JPRB) ) &
   &           - 0.5_JPRB * exp( -1.0_JPRB * ((psolhour(ipf) - 17)/2.0_JPRB) ** 2 )   

ENDDO

DEALLOCATE(zq, zp, zlp, zdp)

! Normalize the predictors
! ------------------------
DO i = 1, jpmxnpred
  DO ipf = 1, klen
    IF (pred(i,ipf)/=RMDI) THEN 
      IF (i>=16 .AND. i<=18) THEN
        !we want these predictors to be 0 over sea after normalization
        pred(i,ipf) = ((pred(i,ipf)-PPREDNORM(1,i))/PPREDNORM(2,i))*MAX(pls5(ipf),pci5(ipf))
      ELSE
      pred(i,ipf) = (pred(i,ipf)-PPREDNORM(1,i))/PPREDNORM(2,i)
    ENDIF
    ENDIF
  ENDDO
ENDDO

! Trajectory run: accumulate statistics
! -------------------------------------
IF (lstats) CALL accum_stats ( pred, kix, knpred, klen, kbdlen, kcount )

WHERE (pred(:,:)==RMDI) pred = 0.0_JPRB

IF (lhook) CALL DR_HOOK(myname,1,zhook_handle)

END SUBROUTINE predictors_rad
!-----------------------------------------------------------------------

SUBROUTINE predictors_to3 (klen, kbdlen, kcount, kix, psolar, knpred, pred, lstats)
!----------------------------------------------------------------------
!   PREDICTORS_TO3 - Ozone bias predictors

!   Purpose. 
!   --------
!   Calculates ozone bias predictors and accumulates statistics

!   Interface.
!   ----------

!   Input arguments: 
!      klen   = actual number of obs (profiles)
!      kbdlen = max number of body entries
!      kcount = actual number of body entries
!      kix    = VarBC obs group ID for each obs
!      psolar = solar elevation for each obs
!      knpred = number of predictors required
!      lstats = accumulate predictor statistics
!   Output arguments:
!      pred   = bias predictors 

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM),INTENT(IN)  :: klen 
INTEGER(KIND=JPIM),INTENT(IN)  :: kbdlen 
INTEGER(KIND=JPIM),INTENT(IN)  :: kcount(klen) 
INTEGER(KIND=JPIM),INTENT(IN)  :: kix(kbdlen,klen) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: psolar(klen) 
INTEGER(KIND=JPIM),INTENT(IN)  :: knpred 
LOGICAL           ,INTENT(IN)  :: lstats
REAL(KIND=JPRB)   ,INTENT(OUT) :: pred(0:knpred,klen) 

! Etc.

INTEGER(KIND=JPIM) :: i, ipf
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (predictors_to3)'

IF (lhook) CALL DR_HOOK(myname,0,zhook_handle)

IF (knpred>jpmxnpred) CALL ABOR1(myname//': Requesting unsupported predictors')

! pred( 0,:) -  1 (constant)
! pred(13,:) -  solar elevation

pred( :,:) = RMDI
pred( 0,:) = 1.0_JPRB
pred(13,:) = psolar(:)

! Normalize the predictors
! ------------------------
DO i = 1, jpmxnpred
  DO ipf = 1, klen
    IF (pred(i,ipf)/=RMDI) THEN 
      pred(i,ipf) = (pred(i,ipf)-PPREDNORM(1,i))/PPREDNORM(2,i)
    ENDIF
  ENDDO
ENDDO

! Trajectory run: accumulate statistics
! -------------------------------------
IF (lstats) CALL accum_stats ( pred, kix, knpred, klen, kbdlen, kcount )

WHERE (pred(:,:)==RMDI) pred = 0.0_JPRB

IF (lhook) CALL DR_HOOK(myname,1,zhook_handle)

END SUBROUTINE predictors_to3

SUBROUTINE predictors_airep (klen, kbdlen, kcount, kix, knpred, pred, lstats)
!----------------------------------------------------------------------
!   PREDICTORS_AIREP - AIREP bias predictors

!   Purpose. 
!   --------
!   Calculates AIREP bias predictors and accumulates statistics

!   Interface.
!   ----------

!   Input arguments: 
!      klen   = actual number of obs (profiles)
!      kbdlen = max number of body entries
!      kcount = actual number of body entries
!      kix    = VarBC obs group ID for each obs
!      knpred = number of predictors required
!      lstats = accumulate predictor statistics
!   Output arguments:
!      pred   = bias predictors 

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM),INTENT(IN)  :: klen 
INTEGER(KIND=JPIM),INTENT(IN)  :: kbdlen 
INTEGER(KIND=JPIM),INTENT(IN)  :: kcount(klen) 
INTEGER(KIND=JPIM),INTENT(IN)  :: kix(kbdlen,klen) 
INTEGER(KIND=JPIM),INTENT(IN)  :: knpred 
LOGICAL           ,INTENT(IN)  :: lstats
REAL(KIND=JPRB)   ,INTENT(OUT) :: pred(0:knpred,klen) 

! Etc.

INTEGER(KIND=JPIM) :: i, ipf
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (predictors_airep)'

IF (lhook) CALL DR_HOOK(myname,0,zhook_handle)

IF (knpred>jpmxnpred) CALL ABOR1(myname//': Requesting unsupported predictors')

! pred( 0,:) -  1 (constant)
!WRITE(NULOUT,'('' Predictors_airep '')')
!call flush(NULOUT)

pred( :,:) = RMDI
pred( 0,:) = 1.0_JPRB

! Normalize the predictors
! ------------------------
DO i = 1, jpmxnpred
! WRITE(NULOUT,'('' i= '',i10)') i
  DO ipf = 1, klen
!   WRITE(NULOUT,'('' ipf(in)= '',i10,x,3(f12.4,x)') pred(i,ipf),PPREDNORM(1,i),PPREDNORM(2,i)
    IF (pred(i,ipf)/=RMDI) THEN 
      pred(i,ipf) = (pred(i,ipf)-PPREDNORM(1,i))/PPREDNORM(2,i)
    ENDIF
!   WRITE(NULOUT,'('' ipf(out)= '',f12.4)') pred(i,ipf)
  ENDDO
ENDDO

! Trajectory run: accumulate statistics
! -------------------------------------
IF (lstats) CALL accum_stats ( pred, kix, knpred, klen, kbdlen, kcount )

WHERE (pred(:,:)==RMDI) pred = 0.0_JPRB

IF (lhook) CALL DR_HOOK(myname,1,zhook_handle)

END SUBROUTINE predictors_airep

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

SUBROUTINE accum_stats ( pred, kix, knpred, klen, kbdlen, kcount )

!  Accumulate bias predictor statistics

!   Input arguments: 
!      pred   = predictor values
!      kix    = VarBC obs group ID for each obs
!      knpred = number of predictors required
!      klen   = actual number of obs (profiles)
!      kbdlen = max number of body entries
!      kcount = actual number of body entries

REAL(KIND=JPRB)   ,INTENT(IN) :: pred(0:knpred,klen) 
INTEGER(KIND=JPIM),INTENT(IN) :: kix(klen,kbdlen)
INTEGER(KIND=JPIM),INTENT(IN) :: knpred 
INTEGER(KIND=JPIM),INTENT(IN) :: klen 
INTEGER(KIND=JPIM),INTENT(IN) :: kbdlen 
INTEGER(KIND=JPIM),INTENT(IN) :: kcount(klen) 

INTEGER(KIND=JPIM) :: i, ipf, j, ix, ibd
LOGICAL            :: LL_mask_kix(klen)
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (accum_stats)'

IF (lhook) CALL DR_HOOK(myname,0,zhook_handle)

IF (.NOT. LREPRO4DVAR) THEN

!$OMP ORDERED
  DO ix = 1, nobgroup 
    ! See if any pred data applies to this obgroup
    LL_mask_kix(:) = .FALSE.
    DO ibd=1, kbdlen
      LL_mask_kix(:) = LL_mask_kix(:) .OR. (kix(:,ibd) == ix .AND. ibd <= kcount(:) )
    ENDDO
    IF( .NOT. ANY( LL_mask_kix ) ) CYCLE
    
    DO i = 0, knpred
      apredmean(i,ix) = apredmean(i,ix) + &
        & SUM( pred(i,:), MASK = (pred(i,:)/=RMDI) .AND. LL_mask_kix)
      
      DO j = i, knpred
        mpredxcnt(i,j,ix) = mpredxcnt(i,j,ix) + &
          & COUNT((pred(i,:)/=RMDI) .AND. (pred(j,:)/=RMDI) .AND. LL_mask_kix)
        apredxcov(i,j,ix) = apredxcov(i,j,ix) + SUM(pred(i,:)*pred(j,:), &
          &  MASK= (pred(i,:)/=RMDI) .AND. (pred(j,:)/=RMDI) .AND. LL_mask_kix)
      ENDDO
    ENDDO
  ENDDO
!$OMP END ORDERED

ELSE

!$OMP CRITICAL
  DO i = 1, klen
    IF (nmixbuf_cnt+2+kcount(i) > nmixbuf_len) &
      & CALL ABOR1(myname//': nmixbuf_len too small')
    IF (napredbuf_cnt+knpred+1 > napredbuf_len) &
      & CALL ABOR1(myname//': napredbuf_len too small')

    mixbuf(nmixbuf_cnt+1) = kcount(i)
    mixbuf(nmixbuf_cnt+2) = knpred
    mixbuf(nmixbuf_cnt+3:nmixbuf_cnt+3+kcount(i)-1) = kix(i,1:kcount(i))
    nmixbuf_cnt = nmixbuf_cnt + 2 + kcount(i)

    apredbuf(napredbuf_cnt+1:napredbuf_cnt+1+knpred) = pred(0:knpred,i)
    napredbuf_cnt = napredbuf_cnt + knpred + 1
  ENDDO
!$OMP END CRITICAL

ENDIF

IF (lhook) CALL DR_HOOK(myname,1,zhook_handle)

END SUBROUTINE accum_stats

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

SUBROUTINE print_stats
!-----------------------------------------------------------------------
!   PRINT_STATS - Finalize and print bias predictor statistics

!   Purpose. 
!   --------
!   Finalizes bias predictor statistics collected in EVAL_PREDICTORS
!   and prints them

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM)              :: i_nw  
INTEGER(KIND=JPIM)              :: i_nw2 
REAL(KIND=JPRB)                 :: zcorr
REAL(KIND=JPRB)   , ALLOCATABLE :: zwork_cov(:), zwork_mean(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: iwork_cnt(:)
REAL(KIND=JPRB)   , ALLOCATABLE :: zpreds(:,:), zpredxcov(:,:), zpredxcovg(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: ipredxcnt(:), inl(:)
INTEGER(KIND=JPIM)              :: i, j, i_k, ii, jj, i_kk, i_kkg
INTEGER(KIND=JPIM)              :: ix, icount, inpred, inobs
INTEGER(KIND=JPIM)              :: imixbuf_idx, iapredbuf_idx
INTEGER(KIND=JPIM)              :: ixs(jpmxngroup)
CHARACTER(LEN=3)                :: clpred(0:jpmxnpred)
CHARACTER(LEN=8)                :: clcorr(0:jpmxnpred)
REAL(KIND=JPRB)                 :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (print_stats)'

IF (lhook) CALL DR_HOOK(myname,0,zhook_handle)

WRITE(nulout,'(/,a)') myname//': Gather and print predictor statistics'

IF (LIFSTRAJ) THEN
  IF (.NOT. LREPRO4DVAR) THEN  

    ! Size of packed arrays for message passing
    i_nw  = nobgroup * (jpmxnpred+1) * (jpmxnpred+2)/2 ! triangular
    i_nw2 = nobgroup * (jpmxnpred+1)

    ALLOCATE( iwork_cnt(i_nw) ) 
    ALLOCATE( zwork_cov(i_nw), zwork_mean(i_nw2) )

    ! Sum across processors
    ! ---------------------
    ii = 0
    jj = 0
    DO ix = 1,nobgroup
      DO i = 0, jpmxnpred
        ii = ii + 1      
        zwork_mean(ii) = apredmean(i,ix)
        DO j = i, jpmxnpred
          jj = jj + 1
          iwork_cnt(jj) = mpredxcnt(i,j,ix) 
          zwork_cov(jj) = apredxcov(i,j,ix)
        ENDDO
      ENDDO
    ENDDO
    
    CALL GSTATS(308,0)
    CALL mpl_allreduce(iwork_cnt, 'sum',ldreprod=.FALSE.,CDSTRING=myname)
    CALL mpl_allreduce(zwork_mean,'sum',ldreprod=.TRUE. ,CDSTRING=myname)
    CALL mpl_allreduce(zwork_cov, 'sum',ldreprod=.TRUE. ,CDSTRING=myname)
    CALL GSTATS(308,1)

    ii = 0
    jj = 0
    DO ix = 1,nobgroup
      DO i = 0, jpmxnpred
        ii = ii + 1    
        apredmean(i,ix) = zwork_mean(ii) 
        DO j = i, jpmxnpred
          jj = jj + 1
          mpredxcnt(i,j,ix) = iwork_cnt(jj) 
          apredxcov(i,j,ix) = zwork_cov(jj)
        ENDDO
      ENDDO
    ENDDO
    
    DEALLOCATE( iwork_cnt ) 
    DEALLOCATE( zwork_cov, zwork_mean )
    
  ELSE

    inobs = SUM(mlnset(1:nsetot)) + nsetot + 1
    i_nw  = (jpmxnpred+1) * (jpmxnpred+2)/2 ! triangular
    i_nw2 = jpmxnpred+1

    ALLOCATE( zpreds(inobs+1,0:jpmxnpred) )
    ALLOCATE( ipredxcnt(i_nw) )
    ALLOCATE( zpredxcov(inobs+1,i_nw) )
    ALLOCATE( zpredxcovg(i_nw) )
    ALLOCATE( inl(i_nw) )
    
    DO ix = 1,nobgroup
      imixbuf_idx = 0
      iapredbuf_idx = 0
      i_kk = 0
      DO i = 1, inobs
        zpreds(i_kk+1,0:jpmxnpred) = 0.0_JPRB
        IF (imixbuf_idx >= nmixbuf_cnt) GOTO 100
        icount = mixbuf(imixbuf_idx+1)
        inpred = mixbuf(imixbuf_idx+2)        
        IF (icount > jpmxngroup) &
        & CALL ABOR1(myname//': too many groups')
        IF (inpred > jpmxnpred) &
        & CALL ABOR1(myname//': too many preds')
        ixs(1:icount) = mixbuf(imixbuf_idx+3:imixbuf_idx+3+icount-1)
        imixbuf_idx = imixbuf_idx + 2 + icount
        zpreds(i_kk+1,0:inpred) = apredbuf(iapredbuf_idx+1:iapredbuf_idx+1+inpred)
        iapredbuf_idx = iapredbuf_idx + inpred + 1
        IF (ANY(ixs(1:icount) == ix)) i_kk = i_kk + 1
      ENDDO

      PRINT *, 'Not enough inobs',inobs
      CALL ABOR1(myname//': more observations than inobs')

100   CONTINUE

      i_kkg = i_kk
      CALL GSTATS(308,0)
      CALL mpl_allreduce(i_kkg,'sum',ldreprod=.FALSE.,cdstring=myname)
      CALL GSTATS(308,1)

      IF (i_kkg == 0) CYCLE

      ipredxcnt(:) = 0
      zpredxcov(:,:) = 0.0_JPRB

      jj = 0
      DO i = 0, jpmxnpred
        DO j = i, inpred
          jj = jj + 1
          DO i_k = 1, i_kk
            IF ((zpreds(i_k,i) /= RMDI) .AND. zpreds(i_k,j) /= RMDI) THEN
              zpredxcov(i_k,jj) = zpreds(i_k,i)*zpreds(i_k,j)             
              ipredxcnt(jj)   = ipredxcnt(jj) + 1
            ENDIF
          ENDDO
        ENDDO
      ENDDO

      inl(:) = i_kk
      CALL order_indep_global_sum2(zpreds(1:i_kk,:),apredmean(:,ix),i_nw2,1,inl(1:i_nw2))
      CALL order_indep_global_sum2(zpredxcov(1:i_kk,:),zpredxcovg,i_nw,1,inl(1:i_nw))
      CALL mpl_allreduce(ipredxcnt(:),'sum',ldreprod=.FALSE.,CDSTRING=myname)

      CALL GSTATS(308,0)
      jj = 0
      DO i = 0, jpmxnpred
        DO j = i, jpmxnpred
          jj = jj + 1
          mpredxcnt(i,j,ix) = ipredxcnt(jj)
          apredxcov(i,j,ix) = zpredxcovg(jj)
        ENDDO
      ENDDO
      CALL GSTATS(308,1)
    ENDDO

    DEALLOCATE( zpreds )
    DEALLOCATE( ipredxcnt )
    DEALLOCATE( zpredxcov )
    DEALLOCATE( zpredxcovg )
    DEALLOCATE( inl )
  ENDIF

  ! Compute predictor means
  ! ----------------------- 
  DO ix = 1,nobgroup
    DO i = 0, jpmxnpred
      IF (mpredxcnt(i,i,ix)>0) THEN
        apredmean(i,ix) = apredmean(i,ix)/mpredxcnt(i,i,ix)
      ELSE
        apredmean(i,ix) = rmdi
      ENDIF
    ENDDO
  ENDDO

  ! Compute predictor covariances
  ! -----------------------------
  DO ix = 1,nobgroup
    DO i = 0, jpmxnpred
      DO j = i, jpmxnpred
        IF (mpredxcnt(i,j,ix)>0) THEN
          apredxcov(i,j,ix) = apredxcov(i,j,ix)/mpredxcnt(i,j,ix) - &
            & apredmean(i,ix)*apredmean(j,ix)
        ELSE
          apredxcov(i,j,ix) = rmdi
        ENDIF
        apredxcov(j,i,ix) = apredxcov(i,j,ix)
      ENDDO
      apredxcov(i,i,ix) = max(0.0_JPRB,apredxcov(i,i,ix))
    ENDDO
  ENDDO

ENDIF

! Print predictor descriptions and statistics
! ------------------------------------------- 
WRITE(nulout,'(/,a,/)') 'Predictor definitions:'
DO i = 0, jpmxnpred
  IF (i<10) THEN
    WRITE(clpred(i),'(a1,i1,1x)') 'p', i
  ELSE
    WRITE(clpred(i),'(a1,i2)') 'p', i
  ENDIF
  IF (i==0) THEN
     WRITE(nulout,'(3a)') clpred(0), ': ', cpreddesc(0)
  ELSE
    IF (SIZE(pprednorm,1)==1) &
     & WRITE(nulout,'(4a,f8.1)') &
     & clpred(i), ': ', cpreddesc(i), ' divided by ', pprednorm(1,i)
    IF (SIZE(pprednorm,1)==2) &
     & WRITE(nulout,'(4a,f10.1,a,f10.1)') &
     & clpred(i), ': ', cpreddesc(i), ' minus ', pprednorm(1,i), &
     &                               ' divided by ', pprednorm(2,i)
  ENDIF
ENDDO

WRITE(nulout,'(/,a,/)') 'Cross-correlations:'    

DO ix = 1,nobgroup

  WRITE(nulout,*) 'ix', ix
  WRITE(nulout,'(4x,a,4x,a,4x,a,99(5x,a3))') 'nsample','mean','stdv', clpred

  DO i = 0, jpmxnpred
    IF (i<10) THEN
      WRITE(clpred(i),'(a1,i1,1x)') 'p', i
    ELSE
      WRITE(clpred(i),'(a1,i2)') 'p', i
    ENDIF
    IF (mpredxcnt(i,i,ix)>0) THEN
      clcorr(0:jpmxnpred) = '       '
      DO j = 0, jpmxnpred
        IF (mpredxcnt(i,j,ix)>0 .AND. apredxcov(i,i,ix)*apredxcov(j,j,ix)>0) THEN
          zcorr = apredxcov(i,j,ix)/SQRT(apredxcov(i,i,ix)*apredxcov(j,j,ix))
          WRITE(clcorr(j),'(f8.3)') zcorr
        ENDIF
      ENDDO
      WRITE(nulout,'(a,i8,2f8.3,99a8)') &
     & clpred(i),mpredxcnt(i,i,ix),apredmean(i,ix),SQRT(apredxcov(i,i,ix)),clcorr  
    ELSE
      WRITE(nulout,'(a,i8)') clpred(i),mpredxcnt(i,i,ix)
    ENDIF
  ENDDO

ENDDO

WRITE(nulout,'(/)')

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE print_stats

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

END MODULE varbc_pred
