SUBROUTINE SUJBWAVELET

!      SUJBWAVELET - Set up vertical correlation matrices for wavelet Jb

!     Purpose: Set up vertical correlation matrices for wavelet Jb
!     -------

!     Interface: called from SUJBCOV
!     ---------

!     Author: Mike Fisher 98-06-17
!     ------

!     Modifications:
!     -------------
!        D.Dent     : 00-09-01  MPE to MPL conversion
!        M.Fisher   : 00-10-26  Distributed the matrices over PEs
!      R. El Khatib : 01-08-07  Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Fisher   : 01-Aug-2007 Skylined file format
!        M.Fisher   : 06-Aug-2007 use IOSTREAM_MIX
!     ------------------------------------------------------------------

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

USE YOMLUN,     ONLY : NULOUT
USE YOMDIM,     ONLY : NFLEVG, NSMAX
USE YOMMP,      ONLY : MYPROC
USE YOMCT0,     ONLY : NPROC   
USE YOMTAG,     ONLY : MTAGFCE
USE YOMLAP,     ONLY : RLAPIN
USE YOMGEM   , ONLY : VP00     ,VAH      ,VBH
USE YOMJG,      ONLY : REDNMC  ,FCEMN3D, FCEMN2D, FCEMN_DERIVED    ,&
                     & FGSCNM3D, FGSCNM2D, &
                     & SPJB_VARS_INFO, N_SPJB_VARS,LJB_UNIVARIATE, NAEROCV
USE YOMGRB , ONLY : NGRBVO, NGRBD, NGRBT, NGRBQ, NGRBO3, NGRBLNSP, NGRBAERLG
USE YOMWAVELET, ONLY : N_WAVELET_SCALES, N_WAVELET_CUTOFFS,  &
                     & WAVELET_VCOR_STRUCT, LJBWSTATS, &
                     & L_IN_WAVELET_STATS_CALC, WAVELET_VCORS
USE YOM_YGFL , ONLY : YGHG, NGHG, YGRG, NGRG
USE MPL_MODULE, ONLY : MPL_BROADCAST
USE IOSTREAM_MIX, ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
                   & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, &
                   & CLOSE_IOREQUEST

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JSCALE, JN, INSCALES, IOMASTER, ITAG, ICUTOFF, &
                    & JJ, ILV950, JL, IL, IPTOTG, ICUT, ILATS, ILEVS, &
                    & JFIELD, IFIELD, IPTJBVO, IPTJBD, IPTJBTU, IPTJBQ, &
                    & IPTJBO3, IPTJBPSU, IPTJB, INVARS_IN_FILE, &
                    & IVAR,IPTJBGHG(NGHG),IPTJBGRG(NGRG),IGHG,IGRG, &
                    & IPTJBAERO(NAEROCV), IAERO, IORIG, IDATE, ITIME, &
                    & INBSET, IARR(1), JK, ILEFT, IRIGHT, INLEVS, INP, &
                    & INPP1, INSMAX

INTEGER(KIND=JPIM), ALLOCATABLE :: INLONSG(:), ICUTOFFS(:), IBUF(:), &
                       & I_MAT_SKYLINE_LEFT(:), I_MAT_SKYLINE_RIGHT(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZBUF(:), ZBUF2(:,:)

CHARACTER(LEN=10) :: CLID
CHARACTER(LEN=70) :: CLCOM
CHARACTER(LEN=40) :: CLFILE,CLV,CLV_FIRST

REAL(KIND=JPRB) :: ZPRESF(NFLEVG+1), ZPRESH(0:NFLEVG+1), ZFUDGE  ,&
                 & ZFCEMN_VO, ZFCEMN_D, ZFCEMN_TU, ZFCEMN_Q, ZFCEMN_O3, &
                 & ZFCEMN_GHG(NGHG),ZFCEMN_GRG(NGRG), ZFCEMN_AERO(NAEROCV),&
                 & ZFCEMN2D(1),ZFGSCNM(1,0:NSMAX)
LOGICAL :: LLFIRST, LL_CLV_CONSUMED, LL_MATCHED(N_SPJB_VARS)

TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST

REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB) :: ZREDNMC_AERO

#include "abor1.intfb.h"
#include "gppre.intfb.h"
#include "sujbwavallo.intfb.h"
#include "sujbwavstats.intfb.h"

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

!       Calculate Jb statistics from background or forecast differences

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


IF (LJBWSTATS) THEN
  L_IN_WAVELET_STATS_CALC = .TRUE.

  CALL SUJBWAVSTATS

  L_IN_WAVELET_STATS_CALC = .FALSE.

!       The statistics file has been written and closed. It should be possible to 
!       continue with the analysis. This does not yet work, so do a controlled abort.

  CALL ABOR1 ('Jb stats file has been written. Continuing with the analysis does not yet work')
ENDIF

!       Open the stats file and skip past the header

IOMASTER=1
ITAG = MTAGFCE+200

CLFILE='wavelet.cv'
WRITE (NULOUT,*) '  Opening input file ',CLFILE
CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',CLFILE,CDMODE='r',KIOMASTER=IOMASTER)
CALL SETUP_IOREQUEST(YL_IOREQUEST,'RAW')

CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,CDR=CLID)
IF (MYPROC==IOMASTER) THEN
  WRITE (NULOUT,*) 'GSA ID=',CLID
  IF (CLID/='WAVELET-07') CALL ABOR1('Bad file-format ID in GSA file')
ENDIF

CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,CDR=CLCOM)
IF (MYPROC==IOMASTER) THEN
  WRITE (NULOUT,*) ' Description : ',CLCOM
ENDIF

ALLOCATE(IBUF(5))
CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=IBUF)
IF (MYPROC==IOMASTER) THEN
  IORIG    = IBUF(1)
  IDATE    = IBUF(2)
  ITIME    = IBUF(3)
  INBSET   = IBUF(4)
  INSCALES = IBUF(5)
ENDIF
DEALLOCATE(IBUF)

IF (NPROC>1) THEN
  IF (MYPROC==IOMASTER) IARR(1) = INSCALES
  CALL GSTATS(635,0)
  CALL MPL_BROADCAST(IARR,KROOT=IOMASTER,KTAG=ITAG, &
   & CDSTRING='SUJBWAVELET')
  CALL GSTATS(635,1)
  INSCALES = IARR(1)
ENDIF

ALLOCATE (ICUTOFFS(1:INSCALES+1))
CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=ICUTOFFS)

IF (NPROC>1) THEN
  ITAG=ITAG+1
  CALL GSTATS(635,0)
  CALL MPL_BROADCAST(ICUTOFFS(1:INSCALES+1),KROOT=IOMASTER,KTAG=ITAG, &
   & CDSTRING='SUJBWAVELET')
  CALL GSTATS(635,1)
  ITAG=ITAG+1
ENDIF

DO JSCALE=1,INSCALES
  INP   = ICUTOFFS(JSCALE)
  INPP1 = ICUTOFFS(JSCALE+1)
  ALLOCATE(ZBUF(INPP1+1:INP))
  CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR1=ZBUF)
  DEALLOCATE(ZBUF)
ENDDO

DEALLOCATE(ICUTOFFS)

!       Read the power spectrum and initialize FCEMN and FGSCNM

!--- temporary fix until I sort out the IO. We should only have to read
!--- stats for the variables in Jb, and not make assumptions about which
!--- variables are in the file.

WRITE (NULOUT,*) 'READING POWER SPECTRA'

LLFIRST=.TRUE.
LL_MATCHED(:)=.FALSE.
INVARS_IN_FILE=0

PS_READ_LOOP: DO

  CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,CDR=CLV)

  IF (NPROC>1) THEN
    CALL GSTATS(635,0)
    CALL MPL_BROADCAST (CLV,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
    CALL GSTATS(635,1)
    ITAG=ITAG+1
  ENDIF

  WRITE (NULOUT,*) 'READ IDENTIFIER STRING: ',CLV

!--- A string idenitical to the first string indicates we have finished
!--- reading the power spectra, and have started on the covariances.

  IF (LLFIRST) THEN
    CLV_FIRST=CLV
    LLFIRST=.FALSE.
  ELSE
    IF (CLV==CLV_FIRST) THEN
      EXIT PS_READ_LOOP
    ENDIF
  ENDIF

  INVARS_IN_FILE = INVARS_IN_FILE + 1

!--- match the string with a variable in Jb. This is made complicated
!--- by the fact that T and LNSP are treated differently in the
!--- power spectrum and covariance sections of the file.
  
  IFIELD=1
  MATCHUP_LOOP_1: DO

    IF (IFIELD>N_SPJB_VARS) THEN
      WRITE (NULOUT,*) 'STRING DOES NOT MATCH A VARIABLE IN Jb'
      ALLOCATE(IBUF(2))
      CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=IBUF)
      IF (NPROC>1) THEN
        CALL GSTATS(635,0)
        CALL MPL_BROADCAST (IBUF,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
        CALL GSTATS(635,1)
      ENDIF
      INSMAX = IBUF(1)
      INLEVS = IBUF(2)
      DEALLOCATE(IBUF)

      ALLOCATE(ZBUF2(INLEVS,0:INSMAX))
      CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR2=ZBUF2)
      DEALLOCATE(ZBUF2)
      CYCLE PS_READ_LOOP
    ENDIF

    IF (CLV==SPJB_VARS_INFO(IFIELD)%COR_STRING) EXIT MATCHUP_LOOP_1

    IF (SPJB_VARS_INFO(IFIELD)%IGRIBCODE==NGRBLNSP) THEN
      IF (LJB_UNIVARIATE) THEN
        IF (CLV=='LNSP') EXIT MATCHUP_LOOP_1
      ELSE
        IF (CLV=='UNBALANCED LNSP') EXIT MATCHUP_LOOP_1
      ENDIF
    ENDIF

    IF (SPJB_VARS_INFO(IFIELD)%IGRIBCODE==NGRBT) THEN
      IF (LJB_UNIVARIATE) THEN
        IF (CLV=='TEMPERATURE') EXIT MATCHUP_LOOP_1
      ELSE
        IF (CLV=='UNBALANCED TEMPERATURE') EXIT MATCHUP_LOOP_1
      ENDIF
    ENDIF

    IFIELD=IFIELD+1
  ENDDO MATCHUP_LOOP_1

!--- String has been matched. Now read the power spectrum.

  WRITE (NULOUT,*) 'STRING MATCHES Jb VARIABLE ',IFIELD
  print*,'SUJBWAVELET:',SPJB_VARS_INFO(IFIELD)%IGRIBCODE

  IPTJB = SPJB_VARS_INFO(IFIELD)%IPTJB
  LL_MATCHED(IFIELD) = .TRUE.

  IF (SPJB_VARS_INFO(IFIELD)%L_IN_SPA2) THEN
    CALL READ_POWERSPECTRUM (1,ZFCEMN2D,ZFGSCNM(:,:))

    FCEMN2D(IPTJB) = ZFCEMN2D(1)
    FGSCNM2D(0:NSMAX,IPTJB) = ZFGSCNM(1,:)
  ELSE
    CALL READ_POWERSPECTRUM (NFLEVG,FCEMN3D(:,IPTJB),FGSCNM3D(:,:,IPTJB))
  ENDIF
ENDDO PS_READ_LOOP

!--- Abort if not all Jb variables were matched with a power spectrum

IF (.NOT.ALL(LL_MATCHED)) THEN
  WRITE (NULOUT,*) 'POWER SPECTRUM WAS NOT READ FOR ALL Jb FIELDS'
  WRITE (NULOUT,*) LL_MATCHED
  CALL ABOR1 ('POWER SPECTRUM WAS NOT READ FOR ALL Jb FIELDS')
ENDIF

!       Fix up the spectrum at the truncation-limit

FGSCNM3D(:,NSMAX,:) = FGSCNM3D(:,NSMAX-1,:)**2 /FGSCNM3D(:,NSMAX-2,:)
FGSCNM2D(  NSMAX,:) = FGSCNM2D(  NSMAX-1,:)**2 /FGSCNM2D(  NSMAX-2,:)

!       Convert correlation power specta to modal spectra and take inverse
!       square root

DO JN=0,NSMAX
  FGSCNM3D(:,JN,:) = SQRT( (2.0_JPRB * JN + 1.0_JPRB) / FGSCNM3D(:,JN,:) )
  FGSCNM2D(  JN,:) = SQRT( (2.0_JPRB * JN + 1.0_JPRB) / FGSCNM2D(  JN,:) )
ENDDO

!       Allocate and read the vertical covariance structures

ALLOCATE (WAVELET_VCORS (N_WAVELET_SCALES+1,N_SPJB_VARS))

DO JFIELD=1,N_SPJB_VARS
  DO JSCALE=1,N_WAVELET_SCALES+1
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%NLONSG)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%NLONS)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%NSAMPS)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%INDEXG2L)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MASTERPE)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%NLON_OFFSET)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MATS_SKYLINE_LEFT)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MATS_SKYLINE_RIGHT)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MATINVS_SKYLINE_LEFT)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MATINVS_SKYLINE_RIGHT)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%LPELIST)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%LON0G)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%DLON)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%LATSG)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%SAMPAV)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%EVALS)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MATS)
    NULLIFY (WAVELET_VCORS(JSCALE,JFIELD)%MATINVS)
  ENDDO
ENDDO

LL_CLV_CONSUMED=.TRUE.
LL_MATCHED(:)=.FALSE.
COV_SCALES_LOOP: DO JSCALE=N_WAVELET_SCALES+1,1,-1
  IVAR=0
  COV_VARS_LOOP: DO WHILE (IVAR<INVARS_IN_FILE)
    IVAR=IVAR+1

    IF (.NOT.LL_CLV_CONSUMED) THEN
      CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,CDR=CLV)
!--- if IO_GET were able to detect EOF and return a status code, then
!--- CLV should be set to to "END OF FILE" here.
    ENDIF
    LL_CLV_CONSUMED=.FALSE.

    IF (NPROC>1) THEN
      CALL GSTATS(635,0)
      CALL MPL_BROADCAST (CLV,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
      CALL GSTATS(635,1)
      ITAG=ITAG+1
    ENDIF

    IF (CLV=="END OF FILE") EXIT COV_VARS_LOOP

    WRITE (NULOUT,*) 'READ IDENTIFIER STRING: ',CLV

    IFIELD=1
    MATCHUP_LOOP_2: DO
      IF (IFIELD>N_SPJB_VARS) THEN
        WRITE (NULOUT,*) 'STRING DOES NOT MATCH A VARIABLE IN Jb'
    
        ALLOCATE(IBUF(3))
        CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=IBUF)
        IF (NPROC>1) THEN
          CALL GSTATS(635,0)
          CALL MPL_BROADCAST (IBUF,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
          CALL GSTATS(635,1)
        ENDIF
        ICUT  = IBUF(1)
        ILATS = IBUF(2)
        ILEVS = IBUF(3)
        DEALLOCATE(IBUF)

        ALLOCATE(ZBUF(ILATS))
        CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR1=ZBUF)
        DEALLOCATE(ZBUF)

        ALLOCATE (INLONSG(ILATS))
        CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=INLONSG)
        IF (NPROC>1) THEN
          CALL GSTATS(635,0)
          CALL MPL_BROADCAST (INLONSG,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
          CALL GSTATS(635,1)
        ENDIF
        IPTOTG = SUM(INLONSG(:))
        DEALLOCATE (INLONSG)

        ALLOCATE(ZBUF(ILATS))
        CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR1=ZBUF)
        DEALLOCATE(ZBUF)

        DO JJ=1,IPTOTG
          ALLOCATE(I_MAT_SKYLINE_LEFT(ILEVS))
          ALLOCATE(I_MAT_SKYLINE_RIGHT(ILEVS))
          CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=I_MAT_SKYLINE_LEFT)
          CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=I_MAT_SKYLINE_RIGHT)
          IF (NPROC>1) THEN
            CALL GSTATS(635,0)
            CALL MPL_BROADCAST (I_MAT_SKYLINE_LEFT,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
            CALL MPL_BROADCAST (I_MAT_SKYLINE_RIGHT,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
            CALL GSTATS(635,1)
          ENDIF

          DO JK=1,ILEVS
            ILEFT  = I_MAT_SKYLINE_LEFT (JK)
            IRIGHT = I_MAT_SKYLINE_RIGHT(JK)
            ALLOCATE(ZBUF(ILEFT:IRIGHT))
            CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR1=ZBUF)
            DEALLOCATE(ZBUF)
          ENDDO

          DEALLOCATE(I_MAT_SKYLINE_LEFT)
          DEALLOCATE(I_MAT_SKYLINE_RIGHT)

          ALLOCATE(I_MAT_SKYLINE_LEFT(ILEVS))
          ALLOCATE(I_MAT_SKYLINE_RIGHT(ILEVS))
          CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=I_MAT_SKYLINE_LEFT)
          CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=I_MAT_SKYLINE_RIGHT)
          IF (NPROC>1) THEN
            CALL GSTATS(635,0)
            CALL MPL_BROADCAST (I_MAT_SKYLINE_LEFT,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
            CALL MPL_BROADCAST (I_MAT_SKYLINE_RIGHT,ITAG,IOMASTER,CDSTRING='SUJBWAVELET')
            CALL GSTATS(635,1)
          ENDIF

          DO JK=1,ILEVS
            ILEFT  = I_MAT_SKYLINE_LEFT (JK)
            IRIGHT = I_MAT_SKYLINE_RIGHT(JK)
            ALLOCATE(ZBUF(ILEFT:IRIGHT))
            CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR1=ZBUF)
            DEALLOCATE(ZBUF)
          ENDDO

          DEALLOCATE(I_MAT_SKYLINE_LEFT)
          DEALLOCATE(I_MAT_SKYLINE_RIGHT)
        ENDDO
          
        CYCLE COV_VARS_LOOP
      ENDIF

      IF (CLV==SPJB_VARS_INFO(IFIELD)%COR_STRING) EXIT MATCHUP_LOOP_2

      IFIELD=IFIELD+1
    ENDDO MATCHUP_LOOP_2


!--- String has been matched. Now read the square-root and
!--- inverse square-root covariance matrices.

    WRITE (NULOUT,*) 'STRING MATCHES Jb VARIABLE ',IFIELD

    IPTJB = SPJB_VARS_INFO(IFIELD)%IPTJB
    LL_MATCHED(IFIELD) = .TRUE.

    WRITE (NULOUT,*) 'READING COVARIANCES FOR WAVELET SCALE ',JSCALE
    ICUTOFF = N_WAVELET_CUTOFFS(JSCALE)
   
    IF (CLV=='UNBALANCED T AND LNSP' .OR. &
      & CLV=='TEMPERATURE AND LNSP') THEN
      CALL SUJBWAVALLO (WAVELET_VCORS(JSCALE,IFIELD),JSCALE,ICUTOFF,NFLEVG+1, &
       &                YL_IOSTREAM,YL_IOREQUEST)
      IVAR=IVAR+1 ! Increment because two variables have been consumed
    ELSE
      CALL SUJBWAVALLO (WAVELET_VCORS(JSCALE,IFIELD),JSCALE,ICUTOFF,NFLEVG, &
       &                YL_IOSTREAM,YL_IOREQUEST)
    ENDIF

  ENDDO COV_VARS_LOOP
ENDDO COV_SCALES_LOOP

IF (.NOT.ALL(LL_MATCHED(:).OR.SPJB_VARS_INFO(:)%IGRIBCODE==NGRBLNSP)) THEN
  WRITE (NULOUT,*) 'NOT ALL Jb VARIABLES WERE MATCHED IN THE INPUT FILE'
  WRITE (NULOUT,*) LL_MATCHED
  CALL ABOR1 ('NOT ALL Jb VARIABLES WERE MATCHED IN THE INPUT FILE')
ENDIF

!       Close the input file

CALL CLOSE_IOREQUEST(YL_IOREQUEST)
CALL CLOSE_IOSTREAM(YL_IOSTREAM)

!       Estimate profiles of background error standard deviation for those
!       variables which are not used in Jb, but which are nevertheless
!       required for quality control (e.g. total temperature, height, wind).

IPTJBVO = HUGE(IPTJBVO)
IPTJBD  = HUGE(IPTJBD)
IPTJBTU = HUGE(IPTJBTU)
IPTJBQ  = HUGE(IPTJBQ)
IPTJBO3 = HUGE(IPTJBO3)
IPTJBPSU= HUGE(IPTJBPSU)
DO IGHG=1,NGHG
  IPTJBGHG(IGHG) = HUGE(IPTJBGHG(IGHG))
ENDDO
DO IGRG=1,NGRG
  IPTJBGRG(IGRG) = HUGE(IPTJBGRG(IGRG))
ENDDO
DO IAERO=1,NAEROCV
  IPTJBAERO(IAERO) = HUGE(IPTJBAERO(IAERO))
ENDDO

DO JFIELD=1,N_SPJB_VARS
  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBVO) THEN
    IPTJBVO = SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBD) THEN
    IPTJBD = SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBT) THEN
    IPTJBTU = SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBQ) THEN
    IPTJBQ = SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBO3) THEN
    IPTJBO3 = SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBLNSP) THEN
    IPTJBPSU = SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF(NGHG > 0 .OR. NGRG > 0 .OR. NAEROCV > 0) THEN
    DO IGHG=1,NGHG
      IF(SPJB_VARS_INFO(JFIELD)%IGRIBCODE==YGHG(IGHG)%IGRBCODE) &
        & IPTJBGHG(IGHG) = SPJB_VARS_INFO(JFIELD)%IPTJB
     ENDDO
    DO IGRG=1,NGRG
      IF(SPJB_VARS_INFO(JFIELD)%IGRIBCODE==YGRG(IGRG)%IGRBCODE) &
       & IPTJBGRG(IGRG) = SPJB_VARS_INFO(JFIELD)%IPTJB
    ENDDO
    DO IAERO=1,NAEROCV
!BEN It won't work if NAEROCV > 1 - need to make more general !!!
      IF(SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBAERLG) &
       & IPTJBAERO(IAERO) = SPJB_VARS_INFO(JFIELD)%IPTJB
    ENDDO
  ENDIF
ENDDO

IF (IPTJBTU/=HUGE(IPTJBTU)) THEN
  FCEMN_DERIVED%T(:)  = FCEMN3D(:,IPTJBTU) * 2.0_JPRB
ELSE
  CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR TEMPERATURE NOT IN JB')
ENDIF

IF (IPTJBPSU/=HUGE(IPTJBPSU)) THEN
  FCEMN_DERIVED%PS    = FCEMN2D(IPTJBPSU) * 2.0_JPRB
ELSE
  CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR LNSP NOT IN JB')
ENDIF

IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
  DO JJ=1,NFLEVG
    FCEMN_DERIVED%U(JJ) = 0.0_JPRB
    DO JN=0,NSMAX
      FCEMN_DERIVED%U(JJ)  = FCEMN_DERIVED%U(JJ) -0.5_JPRB * RLAPIN(JN) &
       & * (FCEMN3D(JJ,IPTJBVO)**2)                   &
       & * (2.0_JPRB * JN + 1.0_JPRB)          &
       & / (FGSCNM3D(JJ,JN,IPTJBVO)*FGSCNM3D(JJ,JN,IPTJBVO))  
    ENDDO
    FCEMN_DERIVED%U(JJ) = SQRT(FCEMN_DERIVED%U(JJ))
  ENDDO
ELSE
  CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB')
ENDIF

ZPRESH(NFLEVG)=VP00
CALL GPPRE(1,1,1,NFLEVG,VAH,VBH,ZPRESH,ZPRESF)

ILV950=0
DO JL=1,NFLEVG
  IF(ZPRESF(JL)<95000._JPRB) ILV950=JL
ENDDO
IF (ILV950==0) CALL ABOR1 ('CANNOT FIND A LEVEL BELOW 950hP')

WRITE(NULOUT,*) 'height profile is extrapolated below level ',ILV950

IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
  DO JJ=1,NFLEVG
    IL=MIN(JJ,ILV950)
!         Do not try to understand this formula
    ZFUDGE=  (1.6_JPRB+REAL(IL,JPRB) / REAL(NFLEVG,JPRB) &
     & *(1.3_JPRB-1.6_JPRB))* 0.00005_JPRB  
    FCEMN_DERIVED%Z(JJ) = 0.0_JPRB
    DO JN=0,NSMAX
      FCEMN_DERIVED%Z(JJ) = FCEMN_DERIVED%Z(JJ) + (RLAPIN(JN)**2)            &
       & *(ZFUDGE**2)                &
       & *(FCEMN3D(IL,IPTJBVO)**2)          &
       & *(2.0_JPRB * JN + 1.0_JPRB) &
       & /(FGSCNM3D(IL,JN,IPTJBVO)*FGSCNM3D(IL,JN,IPTJBVO))  
    ENDDO
    FCEMN_DERIVED%Z(JJ) = SQRT(FCEMN_DERIVED%Z(JJ))
  ENDDO
ELSE
  CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB')
ENDIF

!       Scale the background errors by REDNMC

FCEMN3D(:,:) = REDNMC*FCEMN3D(:,:)
FCEMN2D(:)   = REDNMC*FCEMN2D(:)
FCEMN_DERIVED%U (:) = REDNMC*FCEMN_DERIVED%U (:)
FCEMN_DERIVED%Z (:) = REDNMC*FCEMN_DERIVED%Z (:)
FCEMN_DERIVED%T (:) = REDNMC*FCEMN_DERIVED%T (:)
FCEMN_DERIVED%PS    = REDNMC*FCEMN_DERIVED%PS

!       Print some diagnostics to the log file

WRITE(NULOUT,*) 'Background error standard deviations have been '//&
 & 'multiplied by REDNMC=',REDNMC  
WRITE(NULOUT,*) 'Jb preliminary vertical stdev profiles:'
WRITE(NULOUT,*) '(-999.0 indicates the variable is not in Jb)'
WRITE(NULOUT,*) ' unbal ps : ',FCEMN2D(IPTJBPSU)*VP00
IF (IPTJBPSU/=HUGE(IPTJBPSU)) THEN
  WRITE(NULOUT,*) ' total ps : ',FCEMN_DERIVED%PS *VP00
ELSE
  WRITE(NULOUT,*) ' total ps : ',-999.0_JPRB
ENDIF


WRITE(NULOUT,*) '       Vor      unbal Div  '//&
 & '    Wind        mass    '//&
 & '     T       unbal T    '//&
 & '     Q       unbal O3'  
DO JJ=1,NFLEVG
  IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
    ZFCEMN_VO = FCEMN3D(JJ,IPTJBVO)
  ELSE
    ZFCEMN_VO = -999.0_JPRB
  ENDIF
  IF (IPTJBD/=HUGE(IPTJBD)) THEN
    ZFCEMN_D = FCEMN3D(JJ,IPTJBD)
  ELSE
    ZFCEMN_D = -999.0_JPRB
  ENDIF
  IF (IPTJBTU/=HUGE(IPTJBTU)) THEN
    ZFCEMN_TU = FCEMN3D(JJ,IPTJBTU)
  ELSE
    ZFCEMN_TU = -999.0_JPRB
  ENDIF
  IF (IPTJBQ/=HUGE(IPTJBQ)) THEN
    ZFCEMN_Q = FCEMN3D(JJ,IPTJBQ)
  ELSE
    ZFCEMN_Q = -999.0_JPRB
  ENDIF
  IF (IPTJBO3/=HUGE(IPTJBO3)) THEN
    ZFCEMN_O3 = FCEMN3D(JJ,IPTJBO3)
  ELSE
    ZFCEMN_O3 = -999.0_JPRB
  ENDIF
  WRITE(NULOUT,'(I3,8(1X,G11.4))') JJ,ZFCEMN_VO,&
   & ZFCEMN_D,FCEMN_DERIVED%U(JJ) ,FCEMN_DERIVED%Z(JJ),&
   & FCEMN_DERIVED%T(JJ),ZFCEMN_TU,ZFCEMN_Q,&
   & ZFCEMN_O3  
ENDDO
IF (NGRG > 0) THEN
   WRITE(NULOUT,*) '      GRG variables'
   WRITE(NULOUT,'(8x,4(A,x),A)') YGRG(1:NGRG)%cname
   DO JJ=1,NFLEVG
     DO IGRG=1,NGRG
       IF (IPTJBGRG(IGRG)/=HUGE(IPTJBGRG(IGRG))) THEN
         ZFCEMN_GRG(IGRG) = FCEMN3D(JJ,IPTJBGRG(IGRG))
       ELSE
         ZFCEMN_GRG(IGRG) = -999.0_JPRB
       ENDIF
     ENDDO
     WRITE(NULOUT,'(I3,5(1X,G11.4))') JJ,ZFCEMN_GRG(1:NGRG)
   ENDDO
 ENDIF

 IF (NGHG > 0) THEN
   WRITE(NULOUT,*) '      GHG variables'
   WRITE(NULOUT,'(8x,2(A,x),A)') YGHG(1:NGHG)%cname
   DO JJ=1,NFLEVG
     DO IGHG=1,NGHG
       IF (IPTJBGHG(IGHG)/=HUGE(IPTJBGHG(IGHG))) THEN
         ZFCEMN_GHG(IGHG) = FCEMN3D(JJ,IPTJBGHG(IGHG))
       ELSE
         ZFCEMN_GHG(IGHG) = -999.0_JPRB
       ENDIF
     ENDDO
     WRITE(NULOUT,'(I3,3(1X,G11.4))') JJ,ZFCEMN_GHG(1:NGHG)
   ENDDO
 ENDIF

!STJ Multiply aerosol background errros by 5.0 for now
! ZREDNMC_AERO =0.7_JPRB
 ZREDNMC_AERO =3.0_JPRB
 IF (NAEROCV > 0) THEN
   WRITE(NULOUT,*) '      AEROSOL variables'
   DO JJ=1,NFLEVG
     DO IAERO=1,NAEROCV
       IF (IPTJBAERO(IAERO)/=HUGE(IPTJBAERO(IAERO))) THEN
!         ZFCEMN_AERO(IAERO) = FCEMN3D(JJ,IPTJBAERO(IAERO))
! BEN - reduce model error for aerosol variable, i.e. new REDNMC
          ZFCEMN_AERO(IAERO) = FCEMN3D(JJ,IPTJBAERO(IAERO)) / REDNMC * ZREDNMC_AERO
       ELSE
         ZFCEMN_AERO(IAERO) = -999.0_JPRB
       ENDIF
     ENDDO
     WRITE(NULOUT,'(I3,3(1X,G11.4))') JJ,ZFCEMN_AERO(1:NAEROCV)
   ENDDO
 ENDIF


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

CONTAINS

SUBROUTINE READ_POWERSPECTRUM (KLEVS,PSTDEV,PCOR)

!           Read the powerspectrum, and return the variance and the
!           correlation spectrum

INTEGER(KIND=JPIM)        , INTENT(IN)  :: KLEVS
REAL(KIND=JPRB)           , INTENT(OUT) :: PSTDEV(:),PCOR(:,0:)

REAL(KIND=JPRB) :: ZVAR
REAL(KIND=JPRB), ALLOCATABLE :: ZSPEC(:,:)

INTEGER(KIND=JPIM) :: INMAX, ILEVS, JLEV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('SUJBWAVELET:READ_POWERSPECTRUM',0,ZHOOK_HANDLE)

ALLOCATE(IBUF(2))
CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,KR1=IBUF)
ITAG=ITAG+1
IF (NPROC>1) THEN
  CALL GSTATS(635,0)
  CALL MPL_BROADCAST(IBUF,KROOT=IOMASTER,KTAG=ITAG, &
   & CDSTRING='SUJBWAVELET:READ_POWERSPECTRUM')
  CALL GSTATS(635,1)
ENDIF

INMAX = IBUF(1)
ILEVS = IBUF(2)
DEALLOCATE(IBUF)

IF (INMAX<NSMAX .OR. ILEVS/=KLEVS) THEN
  WRITE (NULOUT,*) 'sujbwavelet: power spectrum stats resolution problem:'
  WRITE (NULOUT,*) 'Spectral resolution: file=',INMAX,' model=',NSMAX
  WRITE (NULOUT,*) 'Vertical resolution: file=',ILEVS,' model=',KLEVS
  CALL ABOR1 ('sujbwavelet: problem reading power spectrum statistics')
ENDIF

ALLOCATE (ZSPEC(KLEVS,0:INMAX))

CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR2=ZSPEC)

IF (NPROC>1) THEN
  CALL GSTATS(635,0)
  CALL MPL_BROADCAST(ZSPEC,KROOT=IOMASTER,KTAG=ITAG, &
   & CDSTRING='SUJBWAVELET:READ_POWERSPECTRUM')
  CALL GSTATS(635,1)
  ITAG=ITAG+1
ENDIF

DO JLEV=1,KLEVS
  ZVAR = SUM(ZSPEC(JLEV,0:NSMAX))
  PCOR(JLEV,0:NSMAX) = ZSPEC(JLEV,0:NSMAX)/ZVAR
ENDDO

!--- NB: the variance is calculated by summing over the entire spectrum,
!--- not just up to the truncation limit. This ensures that mean gridpoint standard
!--- deviations of background error are the same for all model resolutions

DO JLEV=1,KLEVS
  PSTDEV(JLEV) = SQRT(SUM(ZSPEC(JLEV,0:INMAX)))
ENDDO

DEALLOCATE (ZSPEC)

IF (LHOOK) CALL DR_HOOK('SUJBWAVELET:READ_POWERSPECTRUM',1,ZHOOK_HANDLE)
END SUBROUTINE READ_POWERSPECTRUM

END SUBROUTINE SUJBWAVELET
