SUBROUTINE SUVERTFE1

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

USE YOMDIM   , ONLY : NFLEVG
USE YOMLUN   , ONLY : NULOUT   
USE YOMGEM   , ONLY : VFE_ETAF
USE YOMCVER  , ONLY : RINTE  
USE YOMMP    , ONLY : MYPROC

!**** *SUVERTFE1*  - Setup VERTical Finite Element scheme based on
!                    linear (1) elements

!     Purpose.
!     --------
!           Compute matrix for the vertical integrations based on
!           linear finite elements

!**   Interface.
!     ----------

!     *CALL* SUVERTFE1
!        Explicit arguments :
!        --------------------
!        None

!        Implicit arguments :
!        --------------------
!        YOMDIM
!        YOMLUN
!        YOMGEM
!        YOMCVER

!     Method.
!     -------

!     Externals.
!     ----------
!        MINV

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

!     Author.
!     -------
!        Mariano Hortal ECMWF

!     Modifications.
!     --------------
!        Original : 2000-06
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. Yessad (Sep 2008): use VFE_ETAF
!     ------------------------------------------------------------------

IMPLICIT NONE

REAL(KIND=JPRB) :: ZWORK(2*(NFLEVG+1))
REAL(KIND=JPRB) :: ZAMAT(NFLEVG+1,NFLEVG+1)
REAL(KIND=JPRB) :: ZAMATI(NFLEVG+1,NFLEVG+1)
REAL(KIND=JPRB) :: ZBMAT(NFLEVG+1,NFLEVG+1)
REAL(KIND=JPRB) :: ZPROD(NFLEVG+1,NFLEVG+1)
REAL(KIND=JPRB) :: ZDERI(NFLEVG+1,NFLEVG+1)
REAL(KIND=JPRB) :: ZD(0:NFLEVG+1)

INTEGER(KIND=JPIM) :: I, JI, JJ, JK, JLEV

REAL(KIND=JPRB) :: ZD0, ZDET, ZEPS

LOGICAL :: LLPRINT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

LLPRINT=.FALSE.

! Scheme No 1: integral by NLEVG+1 finite elements with mass matrix
!    DO JLEV=0,NFLEVG
!      VFE_ETAH(JLEV)=REAL(JLEV,JPRB)/NFLEVG
!      IF(JLEV > 0) VFE_ETAF(JLEV)=_HALF_*(VFE_ETAH(JLEV)+VFE_ETAH(JLEV-1))
!    ENDDO
DO JI=1,NFLEVG+1
  IF(JI == 1) THEN
    ZD(JI)=VFE_ETAF(1)
  ELSEIF(JI == NFLEVG+1) THEN
    ZD(JI)=(1.0_JPRB-VFE_ETAF(NFLEVG))
  ELSE
    ZD(JI)=VFE_ETAF(JI)-VFE_ETAF(JI-1)
  ENDIF
ENDDO
ZD(0)=0.0_JPRB
! #### first index is row number, second is column number
ZAMAT(:,:)=0.0_JPRB
DO JJ=1,NFLEVG+1
  IF(JJ > 1) ZAMAT(JJ,JJ-1)=ZD(JJ)/6._JPRB
  IF(JJ < NFLEVG+1) ZAMAT(JJ,JJ)=(ZD(JJ)+ZD(JJ+1))/3._JPRB
  IF(JJ < NFLEVG+1) ZAMAT(JJ,JJ+1)=ZD(JJ+1)/6._JPRB
ENDDO
ZAMAT(NFLEVG+1,NFLEVG+1)=ZD(NFLEVG+1)/3._JPRB

ZBMAT(:,:)=0.0_JPRB
DO JI=1,NFLEVG+1
  DO JJ=1,NFLEVG+1
    IF(JI == JJ+2) THEN
      ZBMAT(JJ,JI)=ZD(JJ+1)**2/24._JPRB
    ELSEIF(JI == JJ+1) THEN
      ZBMAT(JJ,JI)=ZD(JJ)**2/8._JPRB + ZD(JJ)*ZD(JJ+1)/4._JPRB + &
       & ZD(JJ+1)**2/8._JPRB  
    ELSEIF(JI == JJ) THEN
      ZBMAT(JJ,JI)=ZD(JJ-1)*ZD(JJ)/4._JPRB + &
       & 5._JPRB*ZD(JJ)**2/24._JPRB + &
       & ZD(JJ+1)*(ZD(JJ-1)+ZD(JJ))/4._JPRB  
    ELSEIF(JI < JJ) THEN
      ZBMAT(JJ,JI)=(ZD(JI-1)+ZD(JI))/4._JPRB*(ZD(JJ)+ZD(JJ+1))
    ENDIF
  ENDDO
ENDDO
ZBMAT(1,1)=5._JPRB*ZD(1)**2/24._JPRB + ZD(1)*ZD(2)/4._JPRB
DO JJ=2,NFLEVG
  ZBMAT(JJ,1)=ZD(1)*(ZD(JJ)+ZD(JJ+1))/4._JPRB
ENDDO
ZBMAT(NFLEVG+1,1)=ZD(1)*ZD(NFLEVG+1)/4._JPRB
DO JI=2,NFLEVG
  ZBMAT(NFLEVG+1,JI)=(ZD(JI-1)+ZD(JI))*ZD(NFLEVG+1)/4._JPRB
ENDDO
ZBMAT(NFLEVG+1,NFLEVG+1)=ZD(NFLEVG)*ZD(NFLEVG+1)/4._JPRB + &
 & ZD(NFLEVG+1)**2/3._JPRB  
ZBMAT(NFLEVG,NFLEVG+1)=ZD(NFLEVG)**2/8._JPRB + &
 & ZD(NFLEVG)*ZD(NFLEVG+1)/4._JPRB + ZD(NFLEVG+1)**2/6._JPRB  
ZDET=0.0_JPRB
ZEPS=100.0_JPRB*TINY(1.0_JPRB)
ZAMATI(:,:)=ZAMAT(:,:)*NFLEVG
CALL MINV(ZAMATI,NFLEVG+1,NFLEVG+1,ZWORK,ZDET,ZEPS,0,1)
ZAMATI(:,:)=ZAMATI(:,:)*NFLEVG
IF(MYPROC == 1.AND.LLPRINT) THEN
  WRITE(NULOUT,*) ' DETERMINANT OF A*NFLEVG =',ZDET
  WRITE(NULOUT,*) ' MATRIX A*100 :'
  DO JLEV=1,NFLEVG+1
    WRITE(NULOUT,'(100F6.1)') (100._JPRB*ZAMAT(JLEV,I),I=1,NFLEVG+1)
  ENDDO
  WRITE(NULOUT,*) ' INVERSE OF A :'
  DO JLEV=1,NFLEVG+1
    WRITE(NULOUT,'(100F6.0)') (ZAMATI(JLEV,I),I=1,NFLEVG+1)
  ENDDO
  WRITE(NULOUT,*) ' MATRIX B*1E6 :'
  DO JLEV=1,NFLEVG+1
    WRITE(NULOUT,'(100F6.1)') (1.0E6_JPRB*ZBMAT(JLEV,I),I=1,NFLEVG+1)
  ENDDO
ENDIF
ZPROD(:,:)=0.0_JPRB
DO JI=1,NFLEVG+1
  DO JJ=1,NFLEVG+1
    DO JK=1,NFLEVG+1
      ZPROD(JJ,JI)=ZPROD(JJ,JI)+ZAMATI(JJ,JK)*ZBMAT(JK,JI)
    ENDDO
  ENDDO
ENDDO
DO JI=1,NFLEVG
  DO JJ=1,NFLEVG+1
    IF(JI == 1) THEN
      RINTE(JJ,JI)=ZPROD(JJ,JI)+ ZPROD(JJ,JI+1)
    ELSE
      RINTE(JJ,JI)=ZPROD(JJ,JI+1)
    ENDIF
  ENDDO
ENDDO

IF(MYPROC == 1) THEN
  IF(LLPRINT) THEN
    WRITE(NULOUT,*) ' MATRIX FOR INTEGRALS (*1E4):'
    DO JLEV=1,NFLEVG+1
      WRITE(NULOUT,'(100F6.1)') (1.0E4_JPRB*RINTE(JLEV,I),I=1,NFLEVG)
    ENDDO
  ENDIF
  ZDERI(:,:)= ZPROD(:,:)
  ZDET=0.0_JPRB
  ZEPS=100.0_JPRB*TINY(1.0_JPRB)
  CALL MINV(ZDERI,NFLEVG+1,NFLEVG+1,ZWORK,ZDET,ZEPS,0,1)
  IF(LLPRINT) THEN
    WRITE(NULOUT,*) ' DETERMINANT=',ZDET
    WRITE(NULOUT,*) ' INVERSE OF MATRIX FOR INTEGRALS:'
    DO JLEV=1,NFLEVG+1
      WRITE(NULOUT,'(100F6.1)') (ZDERI(JLEV,I),I=1,NFLEVG+1)
    ENDDO
  ENDIF
  WRITE(NULOUT,*) ' DERIVATIVES OF FUNCTION f(x)=1'
  DO JLEV=1,NFLEVG
    ZD0=0.0_JPRB
    DO JK=1,NFLEVG+1
      ZD0=ZD0+ZDERI(JLEV+1,JK)
    ENDDO
    WRITE(NULOUT,*) ' LEVEL ',JLEV,' DERIVATIVE=',ZD0
  ENDDO
ENDIF

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

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