SUBROUTINE WVCOUPLE(PSTEP,KSTPW,LDSTOP,LDWRRE)

!**** *WCOUPLE* - CALLS THE WAVE MODEL TO OBTAIN THE 
!                 CHARNOCK "CONSTANT" FIELD

!     P. VITERBO               E.C.M.W.F.      06/09/88
!     P. VITERBO               E.C.M.W.F.       3/02/92
!     P. VITERBO AND J. DOYLE  E.C.M.W.F.      13/06/96
!     J. DOYLE                 E.C.M.W.F.      08/11/96

!        (CY15R2 VERSION)

!                            1.  U/V AT NLEV ENCODED
!                            2.  U/V (GRIB) PASSED from ATM to WAVE
!                            3.  BETA (LAT/LON WAVE) PASSED FROM WAVE TO ATM
!                            4.  BETA interpolated from (LAT/LON WAVE) to RG
!                            5.  BETA loaded in memory as extra-field 

!        (CY16R1 VERSION)

!     B. HANSEN                E.C.M.W.F.      01/04/97
!                        6.  Restart and Stop signals passed through.

!        (CY18R3 VERSION)
!     J. BIDLOT                E.C.M.W.F.      07/01/98
!                            7. deallocate unused wave model arrays

!     S. Abdalla (ECMWF) 27/11/01: Generalized ATM-WAVE interface
!     J. Bidlot  (ECMWF) 20/11/03: limit interpolation to local grid points
!     G. Mozdzynski      14/01/05: Optimise coupling communications

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

!           THIS ROUTINE CALLS THE WAVE MODEL TO OBTAIN THE CONTRIBUTION
!     OF THE LONG WAVES TO THE TOTAL STRESS. THE INFORMATION IS CARRIED
!     THROUGH AN EQUIVALENT CHARNOCK "CONSTANT" FIELD

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

!           *CALL* *WVCOUPLE(PSTEP,KSTPW,LDSTOP,LDWRRE)*.

!           *WVCOUPLE* IS CALLED FROM *CNT4*.

!           *WVCOUPLE* HAS FOUR INPUT PARAMETERS.

!          PSTEP*  - LENGTH OF THE IFS TIMESTEP IN SECONDS.
!          KSTPW*  - FREQUENCY OF CALL TO THE WAVE MODEL.
!          LDSTOP* - SET .TRUE. IF STOP SIGNAL RECEIVED.
!          LDWRRE* - SET .TRUE. IF RESTART FILE SIGNAL RECEIVED.

!    METHOD.
!     -------

!           FIRST THE CHARNOCK FIELD IS OBTAINED IN A REGULAR LAT/LON
!     GRID, WITH THE LATITUDE POINTS BETWEEN *PPSOUTW AND *PPNORTW. THE
!     ARRAY IS THEN EXTENDED TO COVER THE WHOLE GLOBE AND A CONVERSION
!     TO GAUSSIAN GRID IS MADE. THE FINAL CHARNOCK FIELD IS KEPT
!     CONSTANT UNTIL THE NEXT TIME THE POSTPROCESSING IS CALLED.

!        BRIEFLY, THE LOWEST MODEL LEVEL WINDS AS GLOBAL ARRAYS HAVE
!      BEEN CREATED IN *CALLPAR*
!        THE WAVEMODEL IS CALLED IN THIS ROUTINE, AND THIS WINDS ARE
!     USED AS FORCING CONDITIONS FOR OBTAINING THE WAVE STATE, FROM
!     WHICH THE LONGWAVE CONTRIBUTION TO THE STRESSES IS DERIVED IN THE
!     FORM OF A MODIFIED CHARNOCK CONSTANT AND PASSED TO THE ATMOSPHERIC
!     MODEL AS AN ARRAY IN THE WAVEMODEL GRID (SCANNED SOUTH TO NORTH)
!                   *ZBETAWN*      (NLONW,NLATW).
!     AN INTERPOLATION IS PERFORMED AND THE CORRESPONDING VALUES IN THE
!     ATMOSPHERIC GRID ARE OBTAINED AS AN ATM GRID ARRAY
!     UNTIL THE NEXT TIME THE WAVEMODEL IS CALLED, *VDIFF*
!     WILL CALCULATE THE ROUGHNESS LENGTH OVER THE OCEANS BY USING
!     THIS MODIFIED CHARNOCK CONSTANT IN THE CHARNOCK EQUATION AND
!     *VDFUPDZ0* WILL USE THIS ROUGHNESS LENGTH.

!     EXTERNALS.
!     ----------

!          *WVCOUPLE* CALLS:

!             *WAVEMDL*  - TO RUN THE WAVE MODEL PRODUCING THE STRESSES.
!             *WVWG2RG*  - TO CONVERT FIELDS COMING FROM THE WAVE MODEL
!                          FROM REGULAR GRID TO GAUSSIAN GRID.

!     REFERENCES.
!     -----------

!           NONE.

!  ADD EXTRA FIELDS CODE TO COMMON BLOCK, CHANGE CALLPAR AND THIS 
!  ROUTINE

!  3 FLAVOURS FOR ZBETA, LABELLED ZBETAXX, WHERE XX STANDS FOR

!          WN  - NON-EXTENDED WAVE MODEL GRID
!          WX  - POLE-EXTENDED WAVE MODEL GRID
!          RG  - ATM REDUCED GAUSSIAN GRID

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

USE YOMCT0   , ONLY : LFDBOP
USE YOMCT3   , ONLY : NSTEP
USE YOMDIM   , ONLY : NDGLG    ,NPROMA
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG
USE YOMGRB   , ONLY : NSEC1
USE YOMLUN   , ONLY : NULOUT
USE YOMOP    , ONLY : NFDBREF
USE YOEWCOU  , ONLY : NLONW    ,NLATW    ,NLON1W   ,NLAT1W   ,&
 & NNORXW  ,RDEGREW  ,RNORTW   ,RSOUTW   ,NDURAT   ,&
 & LWCOU   ,LWCOU2W  ,LWCOUNORMS,CBEGDAT ,MASK_WAVE_IN  ,MASK_WAVE_OUT, &
 & LWCUR   ,LWSTOKES ,&
 & LWVIN_MASK_NOT_SET ,LWVOUT_MASK_NOT_SET, LWVIN_UNINITIALISED ,&
 & NWV_W2IWGHT,&
 & RMISSW  ,LWFRSTIME,NADV_WAVE , IWV_LON, IWV_LAT
USE SURFACE_FIELDS_MIX   ,ONLY : YSD_WSD,  YSD_WWD

IMPLICIT NONE

REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTEP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTPW 
LOGICAL           ,INTENT(INOUT) :: LDSTOP
LOGICAL           ,INTENT(INOUT) :: LDWRRE
INTEGER(KIND=JPIM) :: I_NWVFIELDS ! NUMBER OF FIELDS RETURNED FROM WAM
!                                   set with IVWV in SU_SURF_FLDS
INTEGER(KIND=JPIM) :: I_NFIELDS   ! NUMBER OF FIELDS PASSED TO WAM
!                                   set with IVWW in SU_SURF_FLDS
INTEGER(KIND=JPIM) :: I_NC, I_NR, JSN, I_QGAUSS
INTEGER(KIND=JPIM) :: IGPTOTG,IGPTOT,IPROMA,IDGLG
INTEGER(KIND=JPIM), ALLOCATABLE :: ISEC1(:), ISEC2(:)
INTEGER(KIND=JPIM) :: I_WVFLDRG  ! FIRST DIMENSION OF Z_WVFLDRG
REAL(KIND=JPRB), ALLOCATABLE :: Z_FIELDS(:,:)

REAL(KIND=JPRB) :: Z_FCRANGE,ZRCHAR
REAL(KIND=JPRB), ALLOCATABLE :: ZDELLO(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZDXNS(:)
REAL(KIND=JPRB), ALLOCATABLE :: Z_WVFLDRG(:,:), Z_WVFLDWN(:,:,:), Z_WVFLDWX(:,:,:)

INTEGER(KIND=JPIM) :: IDELWI, IDURAT, JLA, JLO, IFLD
INTEGER(KIND=JPIM) :: IWVCL, ILEN, JLAW, JLOW

LOGICAL :: LLFRST, LLRESTARTED
REAL(KIND=JPRB) :: ZHOOK_HANDLE

LOGICAL :: LLFRSTIME
INTEGER(KIND=JPIM) :: INADV

INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "wvrg2xf.intfb.h"
#include "wvwg2rg.intfb.h"
#include "wvxf2gb.intfb.h"

DATA LLFRST/.TRUE./

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

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

IGPTOTG=NGPTOTG
IGPTOT=NGPTOT
IPROMA=NPROMA
IDGLG=NDGLG

IF (NSTEP > 0.AND. LWCOU) THEN
  WRITE(NULOUT,*) '------------------------------------',&
   & '----------------------------------- '        
  WRITE(NULOUT,*) 'THE WAVE MODEL IS CALLED FOR '
  IF (LWCOU2W) THEN
    WRITE(NULOUT,*) 'TWO-WAY INTERACTION BETWEEN WIND AND WAVES '
  ELSE
    WRITE(NULOUT,*) 'ONE-WAY INTERACTION BETWEEN WIND AND WAVES '
  ENDIF
  WRITE(NULOUT,*) ' '
ENDIF

IF (NSTEP == 0.OR. .NOT.LWCOU .AND. LHOOK) CALL DR_HOOK('WVCOUPLE',1,ZHOOK_HANDLE)
IF (NSTEP == 0.OR. .NOT.LWCOU) RETURN

!*    ------------------------------------------------------------------
!*       0.     WAVE MODEL SETUP 
!               ----------------

IF (LLFRST .OR. .NOT.ALLOCATED(MASK_WAVE_OUT) ) THEN

  CALL WVWAMINIT(LWCOU,NULOUT,NLONW,NLATW,RSOUTW,RNORTW)

  RDEGREW=(RNORTW-RSOUTW)/(NLATW-1)

! Allocate and initialise masks for optimised coupling communications
  ALLOCATE(MASK_WAVE_IN(IGPTOTG))
  ALLOCATE(MASK_WAVE_OUT(NLONW,NLATW))
  MASK_WAVE_IN(:)=0
  MASK_WAVE_OUT(:,:)=0
! Set flags to indicate mask and comms data structures are not initialised
  LWVIN_MASK_NOT_SET=.true.
  LWVOUT_MASK_NOT_SET=.true.
  LWVIN_UNINITIALISED=.true.
! Inactive until WV_W2IWGHT is defined.
  NWV_W2IWGHT=0
! Set default for producing global norms
  LWCOUNORMS=.false.

ENDIF


!*       1.    Fetching ATM fields (U10, V10, ... etc.) and their grid: 
!              --------------------------------------------------------

I_NFIELDS=YSD_WWD%NDIM
I_NWVFIELDS=YSD_WSD%NDIM

IF (ALLOCATED (ISEC1)) DEALLOCATE (ISEC1)
IF (ALLOCATED (ISEC2)) DEALLOCATE (ISEC2)
IF (ALLOCATED (Z_FIELDS)) DEALLOCATE (Z_FIELDS)
ALLOCATE (ISEC1(SIZE(NSEC1)))
ALLOCATE (ISEC2(22+IDGLG))
ALLOCATE (Z_FIELDS(IGPTOTG,I_NFIELDS))


CALL WVXF2GB(I_NFIELDS, I_NC, I_NR, Z_FCRANGE,&
 & ISEC1, ISEC2, LWCOUNORMS, Z_FIELDS, IGPTOT, IGPTOTG, IPROMA, IDGLG)


!*       2.    ALLOCATE WAVE RELATED ARRAYS.
!              -------- ---- ------- -------

LLFRSTIME = LWFRSTIME
INADV = NADV_WAVE

CALL WVALLOC(LFDBOP,.TRUE.,LWCOU,LWCOU2W,LWCUR,LLFRSTIME)

ALLOCATE (Z_WVFLDWN(NLONW,NLATW,I_NWVFIELDS))

IF(NWV_W2IWGHT >  0) THEN
  I_WVFLDRG=NWV_W2IWGHT
ELSE
  I_WVFLDRG=IGPTOT
ENDIF
ALLOCATE (Z_WVFLDRG(I_WVFLDRG,I_NWVFIELDS))
ALLOCATE(ZDELLO(NLATW))

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

!*       3.    CALLS THE WAVE MODEL.
!              ----- --- ---- ------

IDURAT=NDURAT
IDELWI=NINT(PSTEP)*KSTPW

CALL WAVEMDL (CBEGDAT, IDELWI, IDURAT,&
 & I_NFIELDS,IGPTOTG, I_NC, I_NR, Z_FCRANGE, ISEC1, ISEC2, RMISSW, Z_FIELDS,&
 & LWCUR ,LWSTOKES,&
 & I_NWVFIELDS, Z_WVFLDWN, NLONW, NLATW, LDSTOP, LDWRRE,&
 & LLRESTARTED, ZDELLO, I_QGAUSS, LWCOUNORMS, MASK_WAVE_IN, MASK_WAVE_OUT,&
 & NFDBREF, LLFRSTIME, INADV)  

LWFRSTIME = LLFRSTIME
NADV_WAVE = INADV

DEALLOCATE (ISEC1)
DEALLOCATE (ISEC2)
DEALLOCATE (Z_FIELDS)

IF ( I_QGAUSS == 1 ) THEN
  NNORXW=0
  NLAT1W=NLATW
  NLON1W=NLONW
ELSE
  NNORXW=NINT((90._JPRB-RNORTW)/RDEGREW)
  NLAT1W=NINT(180._JPRB/RDEGREW)+1
  NLON1W=NLONW
ENDIF

ALLOCATE (Z_WVFLDWX(NLON1W,NLAT1W,I_NWVFIELDS))
ALLOCATE (ZDXNS(NLAT1W))

IF (LLFRST) THEN
  LLFRST=.FALSE.
  IF (LLRESTARTED) THEN
    WRITE (NULOUT,*)'WVCOUPLE: WAM RESTARTED FOR DATE = ', CBEGDAT
  ENDIF
ENDIF
IF ( LDSTOP.OR. LDWRRE) THEN
  WRITE (NULOUT,*)'WVCOUPLE: WAM CREATED RESTART FILES '
ENDIF

!     ------------------------------------------------------------------
!*        4.   DEALLOCATE UNUSED ARRAYS
!              ---------- ------ ------

!  Consider not deallocating to save serial time on large numbers of processors
   CALL WVDEALLOC

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

!*        5.    OBTAINS THE WAVE FIELDS IN THE REDUCED GRID.
!               ------- --- ---- ------ -- --- ------- -----

IF (LWCOU2W) THEN

!         5.1   EXTENDS THE LAT/LON FIELDS TO THE POLAR AREAS.

  CALL SURF_INQ(PRCHAR=ZRCHAR)
  CALL GSTATS(1994,0)
  DO JLA=1,NNORXW
    DO JLO=1,NLON1W
      Z_WVFLDWX(JLO,JLA,1)=ZRCHAR   ! Charnock field
      IF (I_NWVFIELDS >= 2) THEN
        Z_WVFLDWX(JLO,JLA,2:I_NWVFIELDS)=0.0_JPRB  ! other fields
      ENDIF
    ENDDO
  ENDDO
  DO JLA=NNORXW+NLATW+1,NLAT1W
    DO JLO=1,NLON1W
      Z_WVFLDWX(JLO,JLA,1)=ZRCHAR   ! Charnock field
      IF (I_NWVFIELDS >= 2) THEN
        Z_WVFLDWX(JLO,JLA,2:I_NWVFIELDS)=0.0_JPRB  ! other fields
      ENDIF
    ENDDO
  ENDDO

  DO IFLD=1,I_NWVFIELDS
    DO JLA=1,NLATW
      DO JLO=1,NLON1W
        Z_WVFLDWX(JLO,JLA+NNORXW,IFLD)=Z_WVFLDWN(JLO,JLA,IFLD)
      ENDDO
    ENDDO
  ENDDO
  CALL GSTATS(1994,1)

  DO JLA=1,NNORXW
    ZDXNS(JLA)=ZDELLO(NLATW)
  ENDDO
  DO JLA=NNORXW+1,NLATW+NNORXW
    JSN=NLATW+NNORXW-JLA+1
    ZDXNS(JLA)=ZDELLO(JSN)
  ENDDO
  DO JLA=NLATW+NNORXW+1,NLAT1W
    ZDXNS(JLA)=ZDELLO(1)
  ENDDO

!        5.2   CONVERTS FROM REGULAR/IRREGULAR LAT/LON USED BY THE WAVE MODEL
!              INTO THE REDUCED GRID OF THE ATMOSPHERIC MODEL.

  CALL WVWG2RG(Z_WVFLDWX,I_NWVFIELDS,NLON1W,NLAT1W,ZDXNS,I_QGAUSS, &
   & Z_WVFLDRG,IDGLG,I_WVFLDRG, IPROMA)  


!        5.3  DETERMINES THE MASK THAT WILL BE USED BY WAM TO SET
!             WHICH TASKS IN IFS ARE RECEIVING INFORMATION FROM 
!             THE CURRENT TASK.

  IF(LWVOUT_MASK_NOT_SET) THEN
    DO IWVCL=1,4
      DO ILEN=1,NWV_W2IWGHT
        JLOW=IWV_LON(ILEN,IWVCL)
        JLAW=IWV_LAT(ILEN,IWVCL)-NNORXW
        IF(JLAW >= 1 .AND. JLAW <= NLATW) THEN
          MASK_WAVE_OUT(JLOW,JLAW)=1
        ENDIF
      ENDDO
    ENDDO
    LWVOUT_MASK_NOT_SET=.false.
  ENDIF

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

!*       6.    PUT THE FIELD IN THE SURFACE WORK FILE
!              --- --- ----- -- --- ------- ---- ----

  CALL WVRG2XF(Z_WVFLDRG,I_NWVFIELDS,I_WVFLDRG,IPROMA)
  
ENDIF


IF (ALLOCATED(Z_WVFLDRG)) DEALLOCATE(Z_WVFLDRG)
IF (ALLOCATED(Z_WVFLDWX)) DEALLOCATE(Z_WVFLDWX)
IF (ALLOCATED(Z_WVFLDWN)) DEALLOCATE(Z_WVFLDWN)
IF (ALLOCATED(ZDELLO)) DEALLOCATE (ZDELLO)
IF (ALLOCATED(ZDXNS)) DEALLOCATE (ZDXNS)

IF (NSTEP > 0.AND. LWCOU) THEN
  WRITE(NULOUT,*) ' '
  WRITE(NULOUT,*) 'END OF WAVE MODEL CALL '
  WRITE(NULOUT,*) '------------------------------------',&
   & '----------------------------------- '        
ENDIF


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