SUBROUTINE SUJBWAVVC (KSCALE,KNUMB,PLON,PLAT,PGP3,PGP2)

!      SUJBWAVVC - Calculate vertical correlations for wavelet Jb

!     NB: This routine does not give bit-identical results if you change
!     the number of processors. This is OK because it is only called when
!     calculating the Jb statistics.

!     Arguments :
!     -----------
!     Input:
!       KSCALE - Wavelet scale
!       KNUMB - number of elements for which computations are performed
!       PGP3 - 3d fields
!       PGP2 - 2d fields

!     Implicit Output: VCORVO, etc. vertical correlation structures

!     Author:  M. Fisher  *ECMWF* (based on JBVCORG)
!     -------

!     Modifications:
!     --------------
!     ORIGINAL   1998-06-23.
!     M. Fisher :2000-08-24 - Distributed the matrices
!     M. Fisher :2001-10-09 - Reordered the calculation to avoid excessive
!                             message passing.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMWAVELET,ONLY : WAVELET_VCORS
USE YOMJG , ONLY : SPJB_VARS_INFO, N_SPJB_VARS
USE YOMCVA, ONLY : NVA3D, NVA2D
USE YOMGRB , ONLY : NGRBLNSP, NGRBT

INTEGER(KIND=JPIM),INTENT(IN)    :: KSCALE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGP3(NPROMA,NFLEVG,NVA3D) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGP2(NPROMA,NVA2D)

INTEGER(KIND=JPIM) :: JFIELD, IPTJB, ISP
REAL(KIND=JPRB) :: ZTPS0(NPROMA,NFLEVG+1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

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

ISP=HUGE(ISP)
DO JFIELD=1,N_SPJB_VARS
  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBLNSP) THEN
    ISP = SPJB_VARS_INFO(JFIELD)%IPTJB
  ENDIF
ENDDO

! Parallelising over JFIELD does not get much parallelism
! (N_SPJB_VARS is typically about 5), but it is easier
! than parallelising UPDM. (Mike F.)

!$OMP PARALLEL DO PRIVATE(JFIELD,IPTJB,ZTPS0)
DO JFIELD=1,N_SPJB_VARS
  IPTJB = SPJB_VARS_INFO(JFIELD)%IPTJB

  IF (SPJB_VARS_INFO(JFIELD)%L_IN_SPA2) THEN
    IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE/=NGRBLNSP) THEN
      CALL UPDM (PGP2(:,IPTJB),1,WAVELET_VCORS(KSCALE,JFIELD))
    ENDIF
  ELSE
    IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBT) THEN
      IF (ISP==HUGE(ISP)) THEN
        CALL ABOR1 ('T IS IN Jb, BUT LNSP IS MISSING')
      ENDIF
      ZTPS0(1:KNUMB,1:NFLEVG) = PGP3(1:KNUMB,1:NFLEVG,IPTJB)
      ZTPS0(1:KNUMB,NFLEVG+1) = PGP2(1:KNUMB,ISP)
      CALL UPDM (ZTPS0,NFLEVG+1,WAVELET_VCORS(KSCALE,JFIELD))
    ELSE
      CALL UPDM (PGP3(:,:,IPTJB),NFLEVG,WAVELET_VCORS(KSCALE,JFIELD))
    ENDIF
  ENDIF
ENDDO
!$OMP END PARALLEL DO

IF (LHOOK) CALL DR_HOOK('SUJBWAVVC',1,ZHOOK_HANDLE)

CONTAINS
SUBROUTINE UPDM (PGPBUF,KNLEVG,YD_PVC)

USE YOMWAVELET,ONLY : WAVELET_VCOR_STRUCT

IMPLICIT NONE

REAL(KIND=JPRB), DIMENSION(NPROMA,KNLEVG), INTENT(IN)    :: PGPBUF
INTEGER(KIND=JPIM),                        INTENT(IN)    :: KNLEVG
TYPE (WAVELET_VCOR_STRUCT),                INTENT(INOUT) :: YD_PVC

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

INTEGER(KIND=JPIM) :: IGPTOMAT(NPROMA)
INTEGER(KIND=JPIM) :: ILM, JGP, JJ, JI, INS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "sujbgptomat.intfb.h"

IF (LHOOK) CALL DR_HOOK('SUJBWAVVC:UPDM',0,ZHOOK_HANDLE)

!       Identify which matrix each gridpoint updates

CALL SUJBGPTOMAT (KSCALE,KNUMB,YD_PVC,PLON,PLAT,IGPTOMAT)

!     Loop over gridpoints


DO JGP=1,KNUMB
  ILM = IGPTOMAT(JGP) 
  INS = YD_PVC%NSAMPS(ILM) + 1

  DO JJ=1,KNLEVG
    DO JI=1,KNLEVG
      YD_PVC%MATS(JI,JJ,ILM) = YD_PVC%MATS(JI,JJ,ILM)*(REAL(INS-1,JPRB)/REAL(INS,JPRB))  &
       & + (PGPBUF(JGP,JI)-YD_PVC%SAMPAV(JI,ILM))   &
       &  *(PGPBUF(JGP,JJ)-YD_PVC%SAMPAV(JJ,ILM))   &
       &  *(REAL(INS-1,JPRB)/(REAL(INS,JPRB)*REAL(INS,JPRB)))  
    ENDDO
  ENDDO

  YD_PVC%NSAMPS(ILM) = INS
  YD_PVC%SAMPAV(:,ILM) = YD_PVC%SAMPAV(:,ILM)            &
   & + (PGPBUF(JGP,:)-YD_PVC%SAMPAV(:,ILM))/REAL(INS,JPRB)  
ENDDO

IF (LHOOK) CALL DR_HOOK('SUJBWAVVC:UPDM',1,ZHOOK_HANDLE)
END SUBROUTINE UPDM

END SUBROUTINE SUJBWAVVC
