SUBROUTINE INIRP

!**** *INIRP*

!     PURPOSE.
!     --------
!      Computes, in case of modified envelope or spectral smoothing,
!      the corresponding weights in the cost function (XPD*)

!     INTERFACE.
!     ----------
!     CALL INIRP
!         Output in PTRSPOR

!     METHOD.
!     -------

!     AUTHOR.
!     -------
!      P.Marguinaud,Y.Moudden 99-06-22 

!     MODIFICATIONS.
!     --------------
!     D. Giard  99-07-21 impact of grid type
!     D. Giard  99-11-17 new spectral transforms
!     D. Giard  00-09-15 message passing
!     D. Giard  00-12-05 new definition of grid type
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     D. Giard  02-12-09 no (confusing) dependency on grid type
!     D. Giard  02-12-16 LNEWORO3 -> LNEWENV
!     D. Giard  03-01-13 spectral smoothing (XPDL)
!     D. Giard  04-01-07 ARPEGE-ALADIN consistency
!     D. Giard  04-01-08 merge with EINIRP
!     D. Giard  05-04-04 semi-envelope removed
!     ------------------------------------------------------------------

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

USE YOMCT0   , ONLY : LELAM
USE YOMDIM   , ONLY : NMSMAX   ,NSMAX
USE YOMLAP   , ONLY : NASN0
USE YEMLAP   , ONLY : NCPLM 
USE YOMCLA   , ONLY : NLISSP   ,FLISA    ,FLISB
USE PTRSPOR  , ONLY : XPDL

IMPLICIT NONE

INTEGER(KIND=JPIM) :: I, J, JM, JN

REAL(KIND=JPRB) :: ZKR, ZPDL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fkr923.h"


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

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

!*    1. SPECTRAL SMOOTHING
!        ------------------

XPDL(:)=0.0_JPRB

IF (NLISSP == 2) THEN

  IF (LELAM) THEN
! Weights as a function of the radial wavenumber for ALADIN
    I=1
    DO JM=0,NMSMAX
      DO JN=0,NCPLM(JM)-1
        ZKR=FKR923(JN,JM,NSMAX,NMSMAX)-FLISB
        ZPDL=EXP(SIGN(1.0_JPRB,ZKR)*(ABS(ZKR)**FLISA))
        DO J=0,3
          XPDL(I+J)=ZPDL
        ENDDO
        I=I+4
      ENDDO
    ENDDO
  ELSE 
! Weights as a function of the total wavenumber for ARPEGE
    DO JN=0,NSMAX
      ZKR=REAL(JN,JPRB)-FLISB
      ZPDL=EXP(SIGN(1.0_JPRB,ZKR)*(ABS(ZKR)**FLISA))
      DO JM=-JN,JN
        XPDL(NASN0(JN)+JM)=ZPDL
      ENDDO
    ENDDO
  ENDIF

ENDIF

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

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