SUBROUTINE RELAXGP(CDCONF)

!**** *RELAXGP * - Perform relaxation in grib point space

!     Purpose.  
!     --------

!**   Interface.  CALL RELAXGP(CDCONF)
!     ---------- 

!     Explicit arguments : CDCONF - configuration of work
!     --------------------
!        Called by STEPO/STEPOTL.

!     Externals.
!     ----------
!     INV_TRANS

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Linus Magnusson  *ECMWF*
!        The subroutine was splitted from TRANSINH

!     Modifications.
!     --------------
!   L. Batte (IC3) : 07-2013 Adaptation to CY36R4 IFS in EC-Earth v3.0.1
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPHV     ,SPSP     ,SPGFL  ,&
!  & SPVOR_FLT, SPDIV_FLT, &
  & SPT  
USE YOMDIM   , ONLY : LADER    ,NPROMA   ,NGPBLKS, &
  & NSPEC2  ,NFLSUR   ,NFLEVG
USE YOMGMV   , ONLY : GMV,GMVS, &
  & YT0            
USE YOMGFL   , ONLY : GFL
USE YOM_YGFL , ONLY : YQ, YI, YL, YA
USE YOMCT3   , ONLY : NSTEP
USE YOMRLX   , ONLY : LRLXG   ,NFRLXG   ,&
  & LRLXVO   ,LRLXDI   ,LRLXTE, LRLXQ   ,LRLXLP  ,&
  & LRLXQL   ,LRLXQI   ,LRLXQC   ,&
  & XRLXVO   ,XRLXDI   ,XRLXTE, XRLXQ   ,XRLXLP ,&
  & ALATRLX1 ,ALATRLX2 ,ALONRLX1 ,ALONRLX2 ,&
  & NRLXLMIN ,NRLXLMAX ,AXRLX ,AYRLX, AZRLX
USE YOMSRLX  , ONLY : TRLXVO   ,TRLXDI   ,TRLXTE ,TRLXQ   ,TRLXLP   ,&
  & XPRLXG,TRLXQI,TRLXQL,TRLXQC
USE YOMLUN   , ONLY : NULOUT
USE YOMMP    , ONLY : NBSETLEV   ,NBSETSP
USE YOMGC    , ONLY : GELAT, GELAM
USE YOMGEM   , ONLY : NGPTOT
USE YOMCST   , ONLY : RPI

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

IMPLICIT NONE

!  CDCONF(2:2) Definition for INVERSE LEGENDRE TRANSFORM 

!                      Spectral data 
!                  SPA3    SPA5    SPA7
!                 ------------------------
!   Derivatives  |Yes No |Yes No |Yes No | 
! ----------------------------------------
!                |       |       |       |
!    F       T0  | A  G  | B  H  | C  I  |
!    o D         |       |       |       |
!    u a         |-----------------------|
!    r t         |       |       |       |
!    i a     T5  | D  J  | E  K  | F  L  |
!    e           |       |       |       |
!    r           |-----------------------|

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

CHARACTER(LEN=9)  ,INTENT(IN)    :: CDCONF

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

INTEGER(KIND=JPIM) :: JSTEP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB) :: PRLXVO(NFLSUR,NSPEC2), PRLXDI(NFLSUR,NSPEC2) ,&
  & PRLXTE(NFLSUR,NSPEC2,1), PRLXLP(1,NSPEC2)
REAL(KIND=JPRB) :: ZUSRLX

REAL(KIND=JPRB) :: PGPRLXUV(NPROMA,NFLEVG,4,NGPBLKS)
REAL(KIND=JPRB) :: PGPRLXTE(NPROMA,NFLEVG,1,NGPBLKS)
REAL(KIND=JPRB) :: PGPRLXLP(NPROMA,1,NGPBLKS)
REAL(KIND=JPRB) :: ZMASK
REAL(KIND=JPRB) :: ALPHA
REAL(KIND=JPRB) :: PRLXQ,PRLXTV
REAL(KIND=JPRB) :: AX, AY, AZ
REAL(KIND=JPRB) :: FLON1,FLON2,FLAT1,FLAT2
REAL(KIND=JPRB) :: DELTA_MIN,DELTA_MAX,FAC1,FAC2
REAL(KIND=JPRB) :: ZRR
LOGICAL :: LDSCDERS,LDVORGP,LDDIVGP,LDUVDER
INTEGER(KIND=JPIM) :: IVSETSC(1)
INTEGER(KIND=JPIM) :: JKGLO, ICEND, IBL, IOFF, JLEV, JROF

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

#include "abor1.intfb.h"
!#include "transinv_fp.intfb.h"
!#include "transinv_mdl.intfb.h"
INTERFACE
#include "inv_trans.h"
END INTERFACE
!#include "ini1scan2m.intfb.h"

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

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

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


ZRR=1.61_JPRB


! Relaxation
IF (LRLXG .AND. NSTEP > 1) THEN
  WRITE(NULOUT,*)' Relaxation in relaxgp at step ',NSTEP,XPRLXG(1),XPRLXG(2)

  ! Time interpolation for spectral field before transform
  PRLXVO(:,:)=0.0_JPRB
  PRLXDI(:,:)=0.0_JPRB
  PRLXTE(:,:,:)=0.0_JPRB
  PRLXLP(:,:)=0.0_JPRB

  ! reference temperature
  IF (LRLXTE) THEN
    DO JSTEP = 1, NFRLXG
      PRLXTE(:,:,1)=PRLXTE(:,:,1)+TRLXTE(:,:,JSTEP)*XPRLXG(JSTEP)
    ENDDO
  ELSE
    PRLXTE(:,:,1)=SPT(:,:)
  ENDIF
  ! reference vorticity
  IF (LRLXVO) THEN
    DO JSTEP = 1, NFRLXG
      PRLXVO(:,:)=PRLXVO(:,:)+TRLXVO(:,:,JSTEP)*XPRLXG(JSTEP)
    ENDDO
  ELSE
    PRLXVO(:,:)=SPVOR(:,:)
  ENDIF
  ! reference divergence
  IF (LRLXDI) THEN
    DO JSTEP = 1, NFRLXG
      PRLXDI(:,:)=PRLXDI(:,:)+TRLXDI(:,:,JSTEP)*XPRLXG(JSTEP)
    ENDDO
  ELSE
    PRLXDI(:,:)=SPDIV(:,:)
  ENDIF
  ! reference surface pressure
  IF (LRLXLP) THEN
    DO JSTEP = 1, NFRLXG
      PRLXLP(1,:)=PRLXLP(1,:)+TRLXLP(:,JSTEP)*XPRLXG(JSTEP)
    ENDDO
  ELSE
    PRLXLP(1,:)=SPSP(:)
  ENDIF

  LDSCDERS=.FALSE.
  LDVORGP=.FALSE.
  LDDIVGP=.FALSE.
  LDUVDER=.TRUE.
  IVSETSC(1) = NBSETSP

  CALL INV_TRANS(PSPVOR=PRLXVO,PSPDIV=PRLXDI,PSPSC2=PRLXLP,&
    & PSPSC3A=PRLXTE,&
    & LDSCDERS=LDSCDERS,LDVORGP=LDVORGP,LDDIVGP=LDDIVGP,LDUVDER=LDUVDER,&
    & KPROMA=NPROMA,KVSETUV=NBSETLEV,KVSETSC2=IVSETSC(1:1),&
    & KVSETSC3A=NBSETLEV,&
    & PGPUV=PGPRLXUV,PGP2=PGPRLXLP,PGP3A=PGPRLXTE)

  ! actual relaxation in grid point space
  DO JKGLO=1,NGPTOT,NPROMA
    ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1
    IOFF=JKGLO

    ! smoothing parameters
    AX=AXRLX*180._JPRB/RPI
    AY=AYRLX*180._JPRB/RPI
    AZ=AZRLX

    ! upper air variables first
    DO JLEV=1,NFLEVG
      DO JROF=1,ICEND
        !Construct the mask
        ! longitudes
        IF (ALONRLX1*180._JPRB/RPI <=0.1 .AND. &
          & ALONRLX2*180._JPRB/RPI >= 359.9) THEN
 
         FLON1=1._JPRB
         FLON2=1._JPRB
       ELSE
         FLON1=1.0_JPRB/(1.0_JPRB+exp(AX*(GELAM(IOFF+JROF-1)-ALONRLX1)))
         FLON2=1.0_JPRB-1.0_JPRB/(1.0_JPRB+exp(AX*(GELAM(IOFF+JROF-1)-ALONRLX2)))
       ENDIF
       ! latitudes
       IF (ALATRLX1*180._JPRB/RPI >= 89.9) THEN
         ! here we go all the way to the north pole
         FLAT1=1._JPRB
       ELSE
         FLAT1=1.0_JPRB-1.0_JPRB/(1.0_JPRB+exp(AY*(GELAT(IOFF+JROF-1)-ALATRLX1)))
       ENDIF
       IF (ALATRLX2*180._JPRB/RPI <= -89.9) THEN
         ! here we go all the way to the south pole
         FLAT2=1._JPRB
       ELSE
         FLAT2=1.0_JPRB/(1.0_JPRB+exp(AY*(GELAT(IOFF+JROF-1)-ALATRLX2)))
       ENDIF
       ! contruct final mask
       IF(ALONRLX1 < ALONRLX2) THEN
         ZMASK=FLON1*FLON2*FLAT1*FLAT2
       ELSE
         ZMASK=(FLON1+FLON2)*FLAT1*FLAT2
       ENDIF

       ! the relaxation coefficient is changed by the mask
       DELTA_MIN=float(JLEV-NRLXLMIN)
       DELTA_MAX=float(NRLXLMAX-JLEV)
       IF (NRLXLMIN > 1.AND.NRLXLMAX < NFLEVG) THEN
         FAC1=1.0/(1.0+exp(-1.0*AZ*DELTA_MIN))
         FAC2=1.0/(1.0+exp(-1.0*AZ*DELTA_MAX))
       ELSE IF (NRLXLMIN == 1.AND.NRLXLMAX < NFLEVG) THEN
         FAC1=1.0
         FAC2=1.0/(1.0+exp(-1.0*AZ*DELTA_MAX))
       ELSE IF (NRLXLMIN > 1.AND.NRLXLMAX == NFLEVG) THEN
         FAC1=1.0/(1.0+exp(-1.0*AZ*DELTA_MIN))
         FAC2=1.0
       ELSE
         FAC1=1.0
         FAC2=1.0
       ENDIF

       !temperature relaxation
       ALPHA=XRLXTE*ZMASK*FAC1*FAC2
       ZUSRLX=1.0_JPRB/(1.0_JPRB+ALPHA)
       IF (LRLXTE) THEN
         !PRLXQ=0.0_JPRB
         !DO JSTEP = 1, NFRLXG
         !  PRLXQ=PRLXQ+TRLXQ(JROF,JLEV,JSTEP,IBL)*XPRLXG(JSTEP)
         !ENDDO
         !PRLXTV=PGPRLXTE(JROF,JLEV,1,IBL)*(1_JPRB+(ZRR-1)*PRLXQ)
         PRLXTV=PGPRLXTE(JROF,JLEV,1,IBL)*(1_JPRB+(ZRR-1)*GFL(JROF,JLEV,YQ%MP,IBL))
         GMV(JROF,JLEV,YT0%MT,IBL)=(GMV(JROF,JLEV,YT0%MT,IBL) + &
           & ALPHA*PRLXTV)*ZUSRLX
       ENDIF
       
       !  u,v relaxation
       ALPHA=XRLXVO*ZMASK*FAC1*FAC2
       ZUSRLX=1.0_JPRB/(1.0_JPRB+ALPHA)
       
       IF (LRLXVO .OR. LRLXDI) THEN
         GMV(JROF,JLEV,YT0%MU,IBL)=(GMV(JROF,JLEV,YT0%MU,IBL) + &
           & ALPHA*PGPRLXUV(JROF,JLEV,1,IBL))*ZUSRLX
         GMV(JROF,JLEV,YT0%MV,IBL)=(GMV(JROF,JLEV,YT0%MV,IBL) + &
           & ALPHA*PGPRLXUV(JROF,JLEV,2,IBL))*ZUSRLX
       ENDIF

       ! Humidity related fields - all using the same time scale
       ALPHA=XRLXQ*ZMASK*FAC1*FAC2
       ZUSRLX=1.0_JPRB/(1.0_JPRB+ALPHA)
       !Specific humidity
       IF (LRLXQ) THEN
         PRLXQ=0.0_JPRB
         DO JSTEP = 1, NFRLXG
           PRLXQ=PRLXQ+TRLXQ(JROF,JLEV,JSTEP,IBL)*XPRLXG(JSTEP)
         ENDDO
         GFL(JROF,JLEV,YQ%MP,IBL)=(GFL(JROF,JLEV,YQ%MP,IBL) + &
            & ALPHA*PRLXQ)*ZUSRLX
       ENDIF
       !Specific cloud liquid water content
       IF (LRLXQL) THEN
         PRLXQ=0.0_JPRB
         DO JSTEP = 1, NFRLXG
           PRLXQ=PRLXQ+TRLXQL(JROF,JLEV,JSTEP,IBL)*XPRLXG(JSTEP)
         ENDDO
         GFL(JROF,JLEV,YL%MP,IBL)=(GFL(JROF,JLEV,YL%MP,IBL) + &
           & ALPHA*PRLXQ)*ZUSRLX
       ENDIF
       !Specific cloud ice water content
       IF (LRLXQI) THEN
         PRLXQ=0.0_JPRB
         DO JSTEP = 1, NFRLXG
           PRLXQ=PRLXQ+TRLXQI(JROF,JLEV,JSTEP,IBL)*XPRLXG(JSTEP)
         ENDDO
         GFL(JROF,JLEV,YI%MP,IBL)=(GFL(JROF,JLEV,YI%MP,IBL) + &
           & ALPHA*PRLXQ)*ZUSRLX
       ENDIF
       !Cloud cover
       IF (LRLXQC) THEN
         PRLXQ=0.0_JPRB
         DO JSTEP = 1, NFRLXG
           PRLXQ=PRLXQ+TRLXQC(JROF,JLEV,JSTEP,IBL)*XPRLXG(JSTEP)
         ENDDO
         GFL(JROF,JLEV,YA%MP,IBL)=(GFL(JROF,JLEV,YA%MP,IBL) + &
           & ALPHA*PRLXQ)*ZUSRLX
       ENDIF
     ENDDO
   ENDDO

   ! now surface fields (LNSP)

   DO JROF=1,ICEND

     ! Construct the mask
     ! longitudes
     IF (ALONRLX1*180._JPRB/RPI <=0.1 .AND. &
       & ALONRLX2*180._JPRB/RPI >= 359.9) THEN
       FLON1=1._JPRB
       FLON2=1._JPRB
     ELSE
       FLON1=1.0_JPRB/(1.0_JPRB+exp(AX*(GELAM(IOFF+JROF-1)-ALONRLX1)))
       FLON2=1.0_JPRB-1.0_JPRB/(1.0_JPRB+exp(AX*(GELAM(IOFF+JROF-1)-ALONRLX2)))
     ENDIF

     ! latitudes
     IF (ALATRLX1*180._JPRB/RPI >= 89.9) THEN
       ! here we go all the way to the north pole
       FLAT1=1._JPRB
     ELSE
       FLAT1=1.0_JPRB-1.0_JPRB/(1.0_JPRB+exp(AY*(GELAT(IOFF+JROF-1)-ALATRLX1)))
     ENDIF
     IF (ALATRLX2*180._JPRB/RPI <= -89.9) THEN
       ! here we go all the way to the south pole
       FLAT2=1._JPRB
     ELSE
       FLAT2=1.0_JPRB/(1.0_JPRB+exp(AY*(GELAT(IOFF+JROF-1)-ALATRLX2)))
     ENDIF
     ! contruct final mask
     IF(ALONRLX1 < ALONRLX2) THEN
       ZMASK=FLON1*FLON2*FLAT1*FLAT2
     ELSE
       ZMASK=(FLON1+FLON2)*FLAT1*FLAT2
     ENDIF

     ALPHA=XRLXLP*ZMASK
     ZUSRLX=1.0_JPRB/(1.0_JPRB+ALPHA)
     IF (LRLXLP) THEN
       GMVS(JROF,YT0%MSP,IBL)=(GMVS(JROF,YT0%MSP,IBL) + &
         & ALPHA*PGPRLXLP(JROF,1,IBL))*ZUSRLX
     ENDIF
   ENDDO
 ENDDO
ENDIF
WRITE(NULOUT,*) 'Relaxation finished'


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

IF (LHOOK) CALL DR_HOOK('RELAXGP',1,ZHOOK_HANDLE)
END SUBROUTINE RELAXGP

