SUBROUTINE MORTHO(OPK,OPM,K_MITER,K_ITS,KIO,YD_V,YD_AV,YD_BV,P_HES1)

!**** *MORTHO*   - Routine to orthogonalize a vector 

!     Purpose.
!     --------
!        Orthonormalize a vector YD_V(.,its) with respect to the B 
!        inner product and then determine YD_AV(1,its) and YD_BV(.,its). 
!        The B operator is the symmetric positive operator in Ax=cBx
!**   Interface.
!     ----------
!        *CALL* *MORTHO()

!        Explicit arguments :
!        --------------------
!         OPK      : Computes resultant control vector for linear operator
!         OPM      : Multiply by matrix M in Lanczos code (A*x=l*M*x)
!         K_MITER  : Dimension of the system                            (in)
!         K_ITS    : Vector element to be updated by orthonormalization (in)
!         KIO      : Output logical unit                                (in)
!         YD_V     : Vector to be orthonormalized                       (inout)
!         YD_AV    : Vector A                                           (inout)
!         YD_BV    : Vector B                                           (inout)
!         P_HES1   : Projected matrix                                   (out)

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

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

!     Externals.
!     ----------
!        None

!     Reference.
!     ----------
!        See documentation

!     Author.
!     -------
!        Martin van Gijzen *Utrecht University*

!     Modifications.
!     --------------
!        Original : 95-10-5
!        Mike Fisher 97-10-05 : Distributed memory version
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        Y.Tremolet  02-08-08 : Use control_vectors.
!        K. Yessad   08-09-08 : Merge MORTHODM (ARP) and MORTHO (XLA).
!------------------------------------------------------------------------

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

USE CONTROL_VECTORS

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

IMPLICIT NONE
EXTERNAL                           :: OPK
EXTERNAL                           :: OPM
INTEGER(KIND=JPIM),INTENT(IN)      :: K_MITER 
INTEGER(KIND=JPIM),INTENT(IN)      :: K_ITS 
INTEGER(KIND=JPIM),INTENT(IN)      :: KIO
TYPE(CONTROL_VECTOR),INTENT(INOUT) :: YD_V(K_MITER)
TYPE(CONTROL_VECTOR),INTENT(INOUT) :: YD_AV(K_MITER)
TYPE(CONTROL_VECTOR),INTENT(INOUT) :: YD_BV(K_MITER)
REAL(KIND=JPRB),INTENT(OUT)        :: P_HES1(K_MITER,K_MITER) 

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

REAL(KIND=JPRB) :: Z_T
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

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

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

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

!...     Orthogonalize the new basis vector:
DO J = 1, K_ITS-1
  Z_T = DOT_PRODUCT(YD_BV(J),YD_V(K_ITS))
  YD_V(K_ITS)%data = YD_V(K_ITS)%data - Z_T*YD_V(J)%data
ENDDO

!...     Normalize in B-norm:
CALL OPM( YD_V(K_ITS), YD_BV(K_ITS) )
Z_T = DOT_PRODUCT(YD_BV(K_ITS),YD_V(K_ITS))

IF ( Z_T  <=  0.0_JPRB ) THEN
  WRITE(KIO,*) ' DEPENDENT BASIS-VECTORS '
  CALL ABOR1(' DEPENDENT BASIS-VECTORS ')
ELSEIF ( Z_T  <=  1E-12_JPRB ) THEN
  WRITE(KIO,*) ' NEARLY DEPENDENT BASIS-VECTORS '
  Z_T = 1.0_JPRB/SQRT( Z_T )
  YD_V(K_ITS)%data = Z_T*YD_V(K_ITS)%data
  DO J = 1, K_ITS-1
    Z_T = DOT_PRODUCT(YD_BV(J),YD_V(K_ITS))
    YD_V(K_ITS)%data = YD_V(K_ITS)%data - Z_T*YD_V(J)%data
  ENDDO
  CALL OPM( YD_V(K_ITS), YD_BV(K_ITS) )
  Z_T = DOT_PRODUCT(YD_BV(K_ITS),YD_V(K_ITS))
ENDIF
IF ( Z_T  <=  0.0_JPRB ) THEN
  WRITE(KIO,*) ' DEPENDENT BASIS-VECTORS '
  CALL ABOR1(' DEPENDENT BASIS-VECTORS 2')
ENDIF
Z_T = 1.0_JPRB/SQRT( Z_T )
YD_V (K_ITS)%data = Z_T*YD_V (K_ITS)%data
YD_BV(K_ITS)%data = Z_T*YD_BV(K_ITS)%data

!...     Compute Av

CALL OPK( YD_V(K_ITS), YD_AV(K_ITS) )

!...     Compute next row and column of projected matrix
DO J = 1, K_ITS
  P_HES1(J,K_ITS) = DOT_PRODUCT(YD_V(J),YD_AV(K_ITS))
ENDDO

!------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MORTHO',1,ZHOOK_HANDLE)
END SUBROUTINE MORTHO
