SUBROUTINE GEN_CORR_PERT(PGRIDL,P_LENGTH_SCALE,CDTYPE,YDSTREAM,PSPEC,LD_USE_REDUCED_RESOL)

!**** SUBROUTINE GEN_CORR_PERT - GENERATE HORIZONTALLY-CORRELATED PERTURBATIONS

!          MIKE FISHER ECMWF 11-Oct-2004

!*    PURPOSE
!     -------
!          GENERATE HORIZONTALLY-CORRELATED UNIT-VARIANCE RANDOM PERTURBATIONS

!**   INTERFACE
!     ---------

!     ***CALL GEN_CORR_PERT (PGRIDL,P_LENGTH_SCALE)

!        PGRIDL         - DISTRIBUTED GRIDS. DIMENSION=(NGPTOT,*,1).
!                         THE SECOND DIMENSION DETERMINES THE NUMBER OF FIELDS
!                         GENERATED. FOR 'ROTUV', THIS  MUST BE AN EVEN NUMBER,
!                         IN WHICH CASE THE ORDERING IS ALL 'U' FIELDS FOLLOWED
!                         BY ALL 'V' FIELDS.

!        P_LENGTH_SCALE - CORRELATION LENGTH SCALE (METRES) FOR THE FIELDS.
!                         IF CDTYPE=='ROTUV',THE LENGTH SCALE IS FOR (<UU>+<VV>)/2.

!        CDTYPE         - TYPE ('ROTUV'=NON-DIVERGENT WINDS, 'SCALAR'=SCALAR FIELDS).

!        YDSTREAM       - AN INITIALIZED RANDOM NUMBER STREAM.
!        PSPEC          - IF PRESENT, USED INSTEAD OF RANDOM STREAM
!        LD_USE_REDUCED_RESOL - IF PRESENT AND TRUE, USE REDUCED RESOLUTION (T42)
!                               INSTEAD OF MODEL RESOLUTION
!**   EXTERNALS
!     ---------

!*    METHOD
!     ------

!       GENERATE WHITE NOISE IN SPECRAL SPACE, AND CONVOLVE. FOR SMALL LENGTH
!       SCALES, THE CORRELATION MODEL APPROXIMATES: (1+r/L)exp(-r/L).

!**   MODIFICATIONS
!     -------------
!     G. Radnoti  07-June-2006: optional input spectral array instead of random gaussian
!                               inside+some fixes  allow grid resolution different from
!                               model resolution
!     ----------------------------------------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,  DR_HOOK
USE YOMCST   , ONLY : RA
USE YOMLAP   , ONLY : RLAPDI, NASM0, NASM0G, MYMS, NSPZERO
USE YOMGEM   , ONLY : NGPTOT
USE YOMDIM   , ONLY : NSPEC2, NSMAX, NUMP
USE YOMMP    , ONLY : MYSETW, MYSETV, NPROCM
USE YOMCT0   , ONLY : NPRTRV
USE YOMLUN   , ONLY : NULOUT
USE YOMCOSJO , ONLY : OBSCOR_GRID_DEF
USE YOMTRANS , ONLY : LMONO_TRANS
USE RANDOM_NUMBERS_MIX
IMPLICIT NONE

REAL(KIND=JPRB),  INTENT(OUT) :: PGRIDL(:,:,:)
REAL(KIND=JPRB),  INTENT(IN)  :: P_LENGTH_SCALE
CHARACTER(LEN=*), INTENT(IN)  :: CDTYPE
TYPE(randomNumberStream), OPTIONAL, INTENT(INOUT) :: YDSTREAM
REAL(KIND=JPRB), OPTIONAL, INTENT(IN)  :: PSPEC(:,:)
LOGICAL, OPTIONAL, INTENT(IN)  :: LD_USE_REDUCED_RESOL 
INTEGER(KIND=JPIM) :: INLEVS,INVARS,JN,INM,JIR,I,JMLOC,IM,JLEV,INMG, &
                    & ISET, ILEVL
REAL(KIND=JPRB) :: ZHOOK_HANDLE,ZSUM,ZNORM,ZZ,ZBN
REAL(KIND=JPRB), ALLOCATABLE :: ZGN(:) !ZGN(0:NSMAX)
INTEGER(KIND=JPIM), ALLOCATABLE :: ISETS(:)
INTEGER(KIND=JPIM) :: ISMAX,ISPEC2, INUMP, IGPTOT, IPROCM
INTEGER(KIND=JPIM), POINTER :: IMYMS(:),INASM0G(:),INASM0(:),ISPZERO(:)
REAL(KIND=JPRB), POINTER :: ZLAPDI(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZSPECG(:),ZSPA(:,:),ZSPDIV(:,:)

LOGICAL :: LLSQRT, LLRED
INTERFACE
#include "inv_trans.h"
END INTERFACE

#include "abor1.intfb.h"

IF (LHOOK) CALL DR_HOOK('GEN_CORR_PERT',0,ZHOOK_HANDLE)
LLRED=.FALSE.
IF (PRESENT(LD_USE_REDUCED_RESOL)) LLRED=LD_USE_REDUCED_RESOL 
IF (LMONO_TRANS .AND. .NOT.LLRED) CALL ABOR1('MONO-TASKING ASSUMES EXPLICIT RESOL')
IF (LLRED) THEN
  ISMAX=OBSCOR_GRID_DEF%NSMAX
  ISPEC2=OBSCOR_GRID_DEF%NSPEC2
  INUMP=OBSCOR_GRID_DEF%NUMP
  IGPTOT=OBSCOR_GRID_DEF%NGPTOT
  IPROCM=OBSCOR_GRID_DEF%NPROCM(0)
  IMYMS      =>     OBSCOR_GRID_DEF%MYMS
  INASM0G    =>     OBSCOR_GRID_DEF%NASM0G
  INASM0     =>     OBSCOR_GRID_DEF%NASM0
  ISPZERO    =>     OBSCOR_GRID_DEF%NSPZERO
  ZLAPDI     =>     OBSCOR_GRID_DEF%RLAPDI
ELSE
  ISMAX=NSMAX
  ISPEC2=NSPEC2
  INUMP=NUMP
  IGPTOT=NGPTOT
  IPROCM=NPROCM(0)
  IMYMS      =>     MYMS
  INASM0G    =>     NASM0G
  INASM0     =>     NASM0
  ISPZERO    =>     NSPZERO
  ZLAPDI     =>     RLAPDI
ENDIF
ALLOCATE(ZGN(0:ISMAX))
IF (SIZE(PGRIDL,1)/=IGPTOT .OR. SIZE(PGRIDL,3)/=1) THEN
  WRITE (NULOUT,*) 'BAD DIMENSIONS FOR PGRIDL: ',SHAPE(PGRIDL)
  WRITE (NULOUT,*) 'OBSCOR_GRID_DEF%NGPTOT: ',IGPTOT
  WRITE (NULOUT,*) 'NGPTOT: ',NGPTOT
  CALL ABOR1 ('SIZE(PGRIDL,1)/=NGPTOT .OR. SIZE(PGRIDL,3)/=1')
ENDIF
IF (.NOT.PRESENT(YDSTREAM) .AND. .NOT.PRESENT(PSPEC)) THEN
  WRITE (NULOUT,*) 'GEN_CORR_PERT: EITHER YDSTREAM OR PSPEC MUST BE PRESENT'
  CALL ABOR1 ('GEN_CORR_PERT: EITHER YDSTREAM OR PSPEC MUST BE PRESENT')
ENDIF
!GR:  LLSQRT=T: apply square-root of correlation model, without square-root otherwise
LLSQRT=PRESENT(YDSTREAM)
!      Calculate the modal variances for the correlation model

IF (CDTYPE=='ROTUV') THEN

!    Rotational wind: modal variances for vorticity. (Hence the RLAPDI.)
  ZSUM = 0.0_JPRB
  DO JN=0,ISMAX
    ZZ  = 1.0_JPRB + JN*(JN+1)*(P_LENGTH_SCALE/RA)**2
    ZBN = 1.0_JPRB / (ZZ*ZZ*SQRT(ZZ))
   
!GR: JN=0 contribution should not be counted because RLAPDI(0)=0
    IF (JN >0) ZSUM=ZSUM+REAL(2*JN+1,JPRB)*ZBN
    ZGN(JN) = -ZLAPDI(JN) * ZBN
  ENDDO
!GR:  to have unit variance perturbations in gp-space zsum has to be divided by two because divergence is thrown out
  ZSUM=ZSUM/2._JPRB
!    Normalize and sqrt to get the square-root of the correlation model
  IF (LLSQRT) THEN
    ZGN(:) = SQRT(ZGN(:)/ZSUM)
  ELSE
    ZGN(:) = ZGN(:)/ZSUM
  ENDIF
  IF (MOD(SIZE(PGRIDL,2),2) /= 0) THEN
    CALL ABOR1 ('ODD NUMBER OF FIELDS AND ROTUV')
  ENDIF
  INLEVS=SIZE(PGRIDL,2)/2
  INVARS=2
ELSEIF (CDTYPE=='SCALAR') THEN

!GR   CALL ABOR1 ('WARNING: SCALAR OPTION IS UNTESTED. USE AT YOUR OWN RISK')

!    Modal variances for correlated scalar field.
  ZSUM = 0.0_JPRB
  DO JN=0,ISMAX
    ZZ  = 1.0_JPRB + JN*(JN+1)*(P_LENGTH_SCALE/RA)**2
    ZGN(JN) = 1.0_JPRB / (ZZ*ZZ*SQRT(ZZ))
    ZSUM=ZSUM+REAL(2*JN+1,JPRB)*ZGN(JN) 
  ENDDO

!    Normalize and sqrt to get the square-root of the correlation model
  IF (LLSQRT) THEN
    ZGN(:) = SQRT(ZGN(:)/ZSUM)
  ELSE
    ZGN(:) = ZGN(:)/ZSUM
  ENDIF
  INLEVS=SIZE(PGRIDL,2)
  INVARS=1

ELSE
  CALL ABOR1 ('UNRECOGNIZED CDTYPE')
ENDIF

!      Generate random fileds in spectral space
IF (.NOT.PRESENT(PSPEC)) THEN  
  ALLOCATE(ZSPECG((ISMAX+1)*(ISMAX+2)*INLEVS))
  CALL GAUSSIAN_DISTRIBUTION(ZSPECG,YDSTREAM)
ENDIF
!      Distribute the random fields over processors and apply the correlation model

ALLOCATE (ISETS(INLEVS))
IF (LLRED) THEN
  ILEVL=INLEVS
ELSE
  ILEVL=0
  DO JLEV=1,INLEVS
    ISET=1+MOD(JLEV-1,NPRTRV)
    ISETS(JLEV)=ISET
    IF (ISET==MYSETV) ILEVL=ILEVL+1
  ENDDO
ENDIF
ALLOCATE(ZSPA(ILEVL,ISPEC2))
IF (PRESENT(PSPEC)) THEN
  IF (SIZE(ZSPA,1) /= SIZE(PSPEC,1)) WRITE(NULOUT,*) 'WRONG NUMBER OF LEVELS IN PSPEC',SIZE(ZSPA,1),SIZE(PSPEC,1)
  IF (SIZE(ZSPA,1) /= SIZE(PSPEC,1)) CALL ABOR1 ('WRONG NUMBER OF LEVELS IN PSPEC') 
  IF (SIZE(ZSPA,2) /= SIZE(PSPEC,2)) CALL ABOR1 ('WRONG NUMBER OF SPECTRAL COEFFICIENTS IN PSPEC')
ENDIF
I=0
DO JLEV=1,INLEVS
  ISET=1+MOD(JLEV-1,NPRTRV)
  IF (MYSETV==ISET .OR. LLRED) THEN
    I=I+1
    DO JMLOC=1,INUMP
      IM=IMYMS(JMLOC)
      IF (IM==0 .OR. .NOT.LLSQRT) THEN
        ZNORM=1.0_JPRB
      ELSE
        ZNORM=SQRT(2.0_JPRB)
      ENDIF 
      DO JIR=0,MIN(1,IM)
        DO JN=IM,ISMAX
          INM =INASM0(IM)  + (JN-IM)*2 +JIR
          INMG=INASM0G(IM) + (JN-IM)*2 +JIR + (ISMAX+1)*(ISMAX+2)*(JLEV-1)
          IF (PRESENT(PSPEC)) THEN
            ZSPA(I,INM) = PSPEC(I,INM)*ZGN(JN)/ZNORM
          ELSE
            ZSPA(I,INM) = ZSPECG(INMG)*ZGN(JN)/ZNORM
          ENDIF
        ENDDO
      ENDDO
    ENDDO
  ENDIF
ENDDO
IF ((MYSETW == IPROCM .OR. LLRED) .AND. ILEVL>0) THEN
  DO JN=0,ISMAX
    ZSPA(:,ISPZERO(JN)) = 0.0_JPRB
  ENDDO
ENDIF

!    Transform to grid space
iF (CDTYPE=='ROTUV') THEN
  ALLOCATE(ZSPDIV(ILEVL,ISPEC2))
  ZSPDIV(:,:)=0.0_JPRB
  IF (LLRED) THEN
    CALL INV_TRANS (PSPVOR=ZSPA, PSPDIV=ZSPDIV, PGP=PGRIDL,KRESOL=OBSCOR_GRID_DEF%NRESOL_ID)
  ELSE
    CALL INV_TRANS (PSPVOR=ZSPA, PSPDIV=ZSPDIV, KVSETUV=ISETS, PGP=PGRIDL)
  ENDIF
  DEALLOCATE(ZSPDIV)
ELSEIF (CDTYPE=='SCALAR') THEN
  IF (LLRED) THEN
    CALL INV_TRANS (PSPSCALAR=ZSPA, PGP=PGRIDL,KRESOL=OBSCOR_GRID_DEF%NRESOL_ID)
  ELSE
    CALL INV_TRANS (PSPSCALAR=ZSPA, KVSETSC=ISETS, PGP=PGRIDL)
  ENDIF
ELSE
  CALL ABOR1 ('UNRECOGNIZED CDTYPE')
ENDIF
DEALLOCATE(ZGN)
DEALLOCATE (ISETS)
DEALLOCATE(ZSPA)
IF (ALLOCATED(ZSPECG)) DEALLOCATE(ZSPECG)
IF (LHOOK) CALL DR_HOOK('GEN_CORR_PERT',1,ZHOOK_HANDLE)
END SUBROUTINE GEN_CORR_PERT
