SUBROUTINE WVWG2RG(PIN,K_NWVFIELDS,KLORG,KLARG,PDXNS,K_IQGAUSS,&
&                  POUT,KLAGG,KBIG,KPROMA)

!*** *RGW2GG* - INTERPOLATES A FIELD FROM REGULAR TO GAUSSIAN GRID

!     P. VITERBO      E.C.M.W.F.        6/04/89

!     MODIFICATIONS:
!     --------------
!     P. VITERBO   ECMWF,  3/02/92:
!                         CONSIDER REDUCED GRIB AND REMOVE WRAP AROUND.
!     J. BIDLOT    ECMWF, 15/04/97:
!                         ALLOW FOR IRREGULAR LAT-LON GRID FOR WAVE DATA.
!     S. ABDALLA   ECMWF, 27/11/01
!                         GENERALISE WAVE-ATM INTERFACE.
!     J. BIDLOT    ECMWF, 20/11/03:
!                         ONLY PERFORM THE INTERPOLATION FOR THE GRID
!                         POINTS THAT ARE LOCAL. 
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        D.Salmond     22-Nov-2005 Mods for coarser/finer physics

!     PURPOSE.
!     --------

!     *RGW2GG* IS CALLED TO CONVERT A FIELD FROM A LAT/LON (REGULAR OR
!     IRREGULAR) GRID TO GAUSSIAN GRID (REDUCED OR FULL).
!     THERE IS NO INTENTION OF
!     GENERALITY. IT IS DESIGNED PRIMARILY FOR USE WITH THE WAVE COUPLING
!     (NOTE IN PARTICULAR THE SCANNING OF THE LATITUDE LINES.
!     NO DISTINCTION IS MADE BETWEEN LAND AND SEA POINTS.
!     !!! IT IS ONLY VALID FOR GLOBAL MODEL GRID !!!

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

!           *CALL* *WVWG2RG(PIN,NWVFIELDS,KLORG,KLARG,PDXNS,IQGAUSS,
!                           POUT,KLAGG,KBIG)*
!           *RGW2GG* IS CALLED FROM *WCOUPLE*.
!           PARAMETERS - *PIN* - INPUT FIELD IN LAT/LON GRID
!                                    (LATITUDES SCANNED NORTH TO SOUTH)
!                                FOR IRREGULAR GRID, THIS MIGHT MEAN THAT
!                                THE GRID WAS EXTENDED TO THE POLES BY ADDING
!                                GRID POINTS WHICH ARE SPACED REGULARLY FROM
!                                THE LAST LATITUDE OF THE WAVE GRID TO THE POLES
!                        *NWVFIELDS* - Number of fields to pass from WAVE to ATM
!                        *KLORG* - FIRST DIEMENSION OF PIN
!                        *KLARG* - SECOND DIEMESION OF PIN
!                        *PDXNS* - GRID SPACING FOR EACH LATITUDE FROM
!                                  NORTH TO SOUTH (CANNOT BE ZERO !!!)
!                        *IQGAUSS  =1 IF WAM IS USING A QUASI GAUSSIAN GRID
!                        *POUT* - OUTPUT FIELD IN GAUSSIAN REDUCED OR FULL GRID
!                                 (LATITUDES SCANNED NORTH TO SOUTH)
!                        *KLAGG* - NUMBER OF GAUSSIAN GRID LATITUDES
!                        *KBIG* - MAXIMUN DIMENSION OF POUT
!                                 ONLY FOR LOCAL GRID POINTS.

!     METHOD.
!     -------

!           FIRST THE VALUES FOR THE REDUCED GAUSSIAN GRID ARE OBTAINED
!     FROM THE INPUT ARRAY *PIN(KLORG,KLARG)* USING BILINEAR INTERPOLATION.
!     THE FINAL REDUCED GRID ARRAY IS RIGHT-PADDED WITH ZERO VALUES.

!     EXTERNAL.
!     ---------

!        *GAUAW* - TO OBTAIN THE GAUSSIAN LATITUDES.

!     REFERENCE.
!     ----------

!        NONE SO FAR.

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

USE YOMDIM   , ONLY : NDGSAG  ,NDGENG
USE YOMCST   , ONLY : RPI
USE YOEWCOU  , ONLY : RNORTW   , RSOUTW, LWVOUT_MASK_NOT_SET,&
 &NWV_W2IWGHT, IWV_LON     ,IWV_LAT    ,WV_W2IWGHT
USE YOMGEM   , ONLY : NLOENG
USE YOMLEG   , ONLY : RLATIG
USE YOMMP    , ONLY : MY_REGION_NS   ,MY_REGION_EW   ,NSTA     ,NONL     ,&
 & NPTRFRSTLAT,NFRSTLAT ,NLSTLAT  

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: K_NWVFIELDS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLORG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLARG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBIG 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIN(KLORG,KLARG,K_NWVFIELDS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDXNS(KLARG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_IQGAUSS 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: POUT(KBIG,K_NWVFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLAGG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA

REAL(KIND=JPRB) :: ZLATNS(KLAGG), ZCONDX(KLARG)
INTEGER(KIND=JPIM) :: INLON(KLARG)
INTEGER(KIND=JPIM),ALLOCATABLE :: ILOENG(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZRLATIG(:)

INTEGER(KIND=JPIM) :: IILO, ILAT, ILATM, ILATP, ILON, ILONMM, ILONMP,&
 & ILONPM, ILONPP, JLAT, JLON1, JLON2, IFLD  
INTEGER(KIND=JPIM) :: IA, IB, IGL1, IGL2, IGLOFF, ILEN, JGL, JLON
INTEGER(KIND=JPIM) :: JSTGLO, IST, IEND

REAL(KIND=JPRB) :: ZCONS1, ZCONS2, ZCONS4, ZDXMM, ZDXMP, ZDXPM,&
 & ZDXPP, ZDY, ZDYM, ZDYP, ZLATG, ZLONG, ZMONORTH  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF(KBIG < NWV_W2IWGHT ) THEN
  CALL ABOR1("WVWG2RG: PROBLEM: KBIG < NWV_W2IWGHT  !!! ")
ENDIF 

CALL GSTATS(1993,0)

! 1. COMPUTE INTEROLATION WEIGHTS AND INDICES 
!    ----------------------------------------

IF(.NOT.ALLOCATED(WV_W2IWGHT) .OR. LWVOUT_MASK_NOT_SET) THEN

! DEFINE INFORMATION ON WAM EXTENDED IRREGULAR GRID
  IF ( K_IQGAUSS == 1 ) THEN
    ZMONORTH=RNORTW
    ZCONS1=REAL(KLARG-1,JPRB)/(RNORTW-RSOUTW)
  ELSE
    ZMONORTH=90._JPRB
    ZCONS1=REAL(KLARG-1,JPRB)/180._JPRB
  ENDIF
  ZDY=1.0_JPRB/ZCONS1
  DO ILAT = 1,KLARG
    INLON(ILAT) = NINT(360._JPRB/PDXNS(ILAT))
    ZCONDX(ILAT) = 1.0_JPRB/PDXNS(ILAT)
  ENDDO


  ALLOCATE(ILOENG(NDGSAG:NDGENG))
  ALLOCATE(ZRLATIG(NDGSAG:NDGENG))
  ILOENG=NLOENG
  ZRLATIG=RLATIG

! COMPUTE THE GAUSSIAN LATITUDES.
  ZCONS4=180._JPRB/RPI
  DO JLAT=1,KLAGG
    ZLATNS(JLAT)=ZRLATIG(JLAT)*ZCONS4
  ENDDO

! FIND THE FIRST DIMENSION OF WV_W2IWGHT
  IA=MY_REGION_NS
  IB=MY_REGION_EW
  IGLOFF=NPTRFRSTLAT(IA)
  IGL1 = NFRSTLAT(IA)
  IGL2 = NLSTLAT(IA)
  ILEN = 0
  DO JGL=IGL1,IGL2
    JLON1=NSTA(IGLOFF+JGL-IGL1,IB)
    JLON2=JLON1+NONL(IGLOFF+JGL-IGL1,IB)-1
    ILEN=ILEN+(JLON2-JLON1)+1
  ENDDO

  NWV_W2IWGHT=ILEN
  IF(ALLOCATED(WV_W2IWGHT)) DEALLOCATE(WV_W2IWGHT)
  ALLOCATE(WV_W2IWGHT(NWV_W2IWGHT,4))
  IF(ALLOCATED(IWV_LON)) DEALLOCATE(IWV_LON)
  ALLOCATE(IWV_LON(NWV_W2IWGHT,4))
  IF(ALLOCATED(IWV_LAT)) DEALLOCATE(IWV_LAT)
  ALLOCATE(IWV_LAT(NWV_W2IWGHT,4))

! COMPUTE WV_W2IWGHT
  IA=MY_REGION_NS
  IB=MY_REGION_EW
  IGLOFF=NPTRFRSTLAT(IA)
  IGL1 = NFRSTLAT(IA)
  IGL2 = NLSTLAT(IA)

  ILEN = 0
  DO JGL=IGL1,IGL2
    ZLATG=ZMONORTH-ZLATNS(JGL)
    ILAT=ZLATG*ZCONS1
    ILAT=MIN(MAX(ILAT,0),KLARG-1)
    ILATM=ILAT+1
    ILATP=MIN(ILATM+1,KLARG)
    ZDYM=ZLATG-ILAT*ZDY
    ZDYP=ZDY-ZDYM
    ZDYM=ZDYM*ZCONS1
    ZDYP=ZDYP*ZCONS1

    IILO=ILOENG(JGL)
    ZCONS2=360._JPRB/REAL(IILO,JPRB)

    JLON1=NSTA(IGLOFF+JGL-IGL1,IB)
    JLON2=JLON1+NONL(IGLOFF+JGL-IGL1,IB)-1

    DO JLON=JLON1,JLON2
      ZLONG=REAL(JLON-1,JPRB)*ZCONS2

      ILON=INT(ZLONG/PDXNS(ILATM))
      ILONMM=ILON+1
      ILONPM=ILONMM+1
      IF (ILONPM > INLON(ILATM)) ILONPM=1

      ZDXMM=ZLONG-ILON*PDXNS(ILATM)
      ZDXPM=PDXNS(ILATM)-ZDXMM
      ZDXMM=ZDXMM*ZCONDX(ILATM)
      ZDXPM=ZDXPM*ZCONDX(ILATM)

      ILON=INT(ZLONG/PDXNS(ILATP))
      ILONMP=ILON+1
      ILONPP=ILONMP+1
      IF (ILONPP > INLON(ILATP)) ILONPP=1

      ZDXMP=ZLONG-ILON*PDXNS(ILATP)
      ZDXPP=PDXNS(ILATP)-ZDXMP
      ZDXMP=ZDXMP*ZCONDX(ILATP)
      ZDXPP=ZDXPP*ZCONDX(ILATP)

      ILEN=ILEN+1
      IF(ILEN > KBIG ) THEN
         CALL ABOR1("WVWG2RG: PROBLEM ILEN > KBIG !!! ")
      ENDIF 
      IWV_LON(ILEN,1)=ILONMM
      IWV_LAT(ILEN,1)=ILATM
      WV_W2IWGHT(ILEN,1)=ZDXPM*ZDYP

      IWV_LON(ILEN,2)=ILONPM
      IWV_LAT(ILEN,2)=ILATM
      WV_W2IWGHT(ILEN,2)=ZDXMM*ZDYP

      IWV_LON(ILEN,3)=ILONMP
      IWV_LAT(ILEN,3)=ILATP
      WV_W2IWGHT(ILEN,3)=ZDXPP*ZDYM

      IWV_LON(ILEN,4)=ILONPP
      IWV_LAT(ILEN,4)=ILATP
      WV_W2IWGHT(ILEN,4)=ZDXMP*ZDYM

    ENDDO
  ENDDO

  DEALLOCATE(ILOENG)
  DEALLOCATE(ZRLATIG)


ENDIF


! 2. INTERPOLATE TO IFS GRID
!    -----------------------

!$OMP PARALLEL DO SCHEDULE(STATIC)&
!$OMP&PRIVATE(JSTGLO,IST,IEND,IFLD,ILEN)
DO JSTGLO=1,NWV_W2IWGHT,KPROMA
  IST    = JSTGLO 
  IEND   = MIN(JSTGLO+KPROMA-1,NWV_W2IWGHT)

  DO IFLD=1,K_NWVFIELDS
    DO ILEN=IST, IEND
      POUT(ILEN,IFLD)=&
      &(WV_W2IWGHT(ILEN,1)*PIN(IWV_LON(ILEN,1),IWV_LAT(ILEN,1),IFLD)+&
      & WV_W2IWGHT(ILEN,2)*PIN(IWV_LON(ILEN,2),IWV_LAT(ILEN,2),IFLD)+&
      & WV_W2IWGHT(ILEN,3)*PIN(IWV_LON(ILEN,3),IWV_LAT(ILEN,3),IFLD)+&
      & WV_W2IWGHT(ILEN,4)*PIN(IWV_LON(ILEN,4),IWV_LAT(ILEN,4),IFLD))
    ENDDO
  ENDDO
ENDDO
!$OMP END PARALLEL DO


CALL GSTATS(1993,1)

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