subroutine precond (YD_PX,kmat)

!**** precond -- preconditioner for minimization

!     PURPOSE.
!     --------
!        Applies the preconditioner or its inverse or its symmetric
!        square root or the inverse of its symmetric square root.

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

!        *CALL* *PRECOND (PX,KMAT)

!        INPUT:
!        EXPLICIT:-
!              PX     : vector to which preconditioner is to be applied
!              KMAT   : 1 => apply preconditioner (i.e. approx Hessian)
!                      -1 => apply inverse of preconditioner
!                       2 => apply square root of preconditioner
!                      -2 => apply inverse of square root

!        OUTPUT:
!              PX       - result of applying preconditioner to PX

!     METHOD.
!     -------

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

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

!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------

!        M. Fisher     *ECMWF*

!     MODIFICATIONS.
!     --------------

!        ORIGINAL 94-04-28.
!        97-11-26 Mike Fisher - USE DISTRIBUTED_VECTORS_MIX
!        02-08-05 Y.Tremolet  - Use control_vectors.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!        M.Fisher      17-Mar-2004 OpenMP
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT
USE YOMVAR   , ONLY : LMPCGL, L_OPENMP_CV
USE YOMVCGL  , ONLY : YVCGLPC   ,RCGLPC   ,NVCGLPC
USE CONTROL_VECTORS, ONLY : CONTROL_VECTOR, DOT_PRODUCT

IMPLICIT NONE

TYPE(CONTROL_VECTOR),INTENT(INOUT) :: YD_PX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMAT 
REAL(KIND=JPRB) :: zevals(NVCGLPC),zdp(NVCGLPC)

INTEGER(KIND=JPIM) :: jk, ji, istart
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('PRECOND',0,ZHOOK_HANDLE)
IF (LMPCGL) THEN
  if (kmat ==  1) then
    zevals(:) = RCGLPC(:)
  ELSEIF (kmat == -1) then
    zevals(:) = 1.0_JPRB/RCGLPC(:)
  ELSEIF (kmat == 2) then
    zevals(1:NVCGLPC) = sqrt(RCGLPC(:))
  ELSEIF (kmat == -2) then
    zevals(1:NVCGLPC) = 1.0_JPRB/sqrt(RCGLPC(:))
  else
    write (NULOUT,*) 'Error: invalid value for kmat in precond: ',kmat
    call ABOR1('PRECOND: invalid value for kmat' )
  endif

  zdp(:)=DOT_PRODUCT(YVCGLPC(1:NVCGLPC),YD_PX)
  do jk=1,NVCGLPC
    zdp(jk) = (zevals(jk)-1.0_JPRB)*zdp(jk)
  enddo
  IF (MOD(NVCGLPC,2)==0) THEN
    istart=1
  ELSE
    istart=2
  ENDIF

  CALL GSTATS(1230,0)
!$OMP PARALLEL PRIVATE(JI,JK) IF(L_OPENMP_CV)

  IF (istart==2) THEN
!$OMP DO SCHEDULE(STATIC)
    DO ji=1,YD_PX%nsizel
      YD_PX%data(ji) = YD_PX%data(ji) + YVCGLPC(1)%data(ji) * zdp(1)
    ENDDO
!$OMP END DO NOWAIT
!     Warning: NOWAIT is correct here for STATIC scheduling only.
  ENDIF

  DO jk=istart,NVCGLPC-1,2
!$OMP DO SCHEDULE(STATIC)
    DO ji=1,YD_PX%nsizel
      YD_PX%data(ji) = YD_PX%data(ji) + YVCGLPC(jk  )%data(ji) * zdp(jk  ) &
                      &               + YVCGLPC(jk+1)%data(ji) * zdp(jk+1)
    ENDDO
!$OMP END DO NOWAIT
!     Warning: NOWAIT is correct here for STATIC scheduling only.
  ENDDO

!$OMP END PARALLEL
  CALL GSTATS(1230,1)

ENDIF
IF (LHOOK) CALL DR_HOOK('PRECOND',1,ZHOOK_HANDLE)
end subroutine precond
