SUBROUTINE VERINT(KPROMA,KSTART,KPROF,KFLEV,PIN,POUT,KTYPE)

!**** *VERINT*   Vertical integral

!     Purpose.
!     --------
!          This subroutine computes the vertical integral (with respect
!          to eta) of a function given at full model
!          levels using a general scheme
!          The integral is given either from the top (KTYPE=0) down
!          (or from the bottom (KTYPE=1) up) to each full model level

!**   Interface.
!     ----------
!        *CALL* *VERINT(..)

!        Explicit arguments :
!        --------------------

!        INPUT:
!          KPROMA  - horizontal dimension.
!          KSTART  - first element of work.
!          KPROF   - depth of work.
!          KFLEV   - number of model layers.
!          PIN     - Input field
!          KTYPE   - starting point of the integral (0=top, 1=bottom)

!        OUTPUT:
!                    eta
!                     _
!                    |
!          POUT :    | PIN deta   at each half model level
!                   _|
!                 KTYPE

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!           none
!           Called by

!     Reference.

!     Author.
!     -------
!         M. Hortal (ECMWF)

!     Modifications.
!     --------------
!        Original : MAY 2000
!        D.SALMOND : APRIL 2002 FORTRAN Matrix multiply replace by BLAS routine
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        Y.Seity : MAY 2009 bf for B-Level parallelisation
!     ------------------------------------------------------------------

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

USE YOMCVER  , ONLY : LVERTFE  ,RINTE
USE YOMLUN   , ONLY : NULERR

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIN(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: POUT(KPROMA,KFLEV+1) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTYPE 

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

REAL(KIND=JPRB) :: ZOUT(KPROMA,KFLEV+1)

INTEGER(KIND=JPIM) ::  JLEV, JROF, IDB
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('VERINT',0,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

IF(.NOT.LVERTFE) CALL ABOR1(' ! LVERTFE=.F. IN VERINT !!!')
IF(KTYPE /= 0.AND.KTYPE /= 1) THEN
  WRITE(NULERR,*) ' INVALID KTYPE IN VERINT =',KTYPE
  CALL ABOR1(' VERINT: ABOR1 CALLED')
ENDIF

! MATRIX MULTIPLY REPLACED BY BLAS ROUTINE

!DO JLEV=1,KFLEV+1
!  DO JROF=KSTART,KPROF
!    ZOUT(JROF,JLEV)=_ZERO_
!  ENDDO
!ENDDO
!DO JLE=1,KFLEV
!  DO JLEV=1,KFLEV+1
!    DO JROF=KSTART,KPROF
!      ZOUT(JROF,JLEV)=ZOUT(JROF,JLEV)+RINTE(JLEV,JLE)*PIN(JROF,JLE)
!    ENDDO
!  ENDDO
!ENDDO

IDB=SIZE(RINTE,DIM=1)
IF (KPROF >= KSTART) THEN 
  CALL DGEMM('N','T',KPROF-KSTART+1,KFLEV+1,KFLEV, &
   & 1.0_JPRB,PIN,KPROMA,RINTE,IDB,0.0_JPRB,ZOUT,KPROMA)  
ENDIF

IF(KTYPE == 1) THEN
  DO JLEV=1,KFLEV+1
    DO JROF=KSTART,KPROF
      ZOUT(JROF,JLEV)=ZOUT(JROF,JLEV)-ZOUT(JROF,KFLEV+1)
    ENDDO
  ENDDO
ENDIF
DO JLEV=1,KFLEV+1
  DO JROF=KSTART,KPROF
    POUT(JROF,JLEV)=ZOUT(JROF,JLEV)
  ENDDO
ENDDO

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

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