!OPTIONS XOPT(HSFUN)
#ifdef RS6K
@PROCESS NOSTRICT HOT(NOVECTOR)
#endif
SUBROUTINE LUDCMP(PARRAY,KLON,KIDIA,KFDIA,KN,KNP,KINDX) 
!-----------------------------------------------------------------------
! A. TOMPKINS
!
! Given a matrix PARRAY(1:KN,1:KN), with physical dimension KNP by KNP, this 
! routine replaces it by the LU decomposition of a rowwise permutation 
! of itself. PARRAY and KN are input. PARRAY is output
! KINDX(1:KN) is an output vector that records the row permutation 
! effected by the partial pivoting; 
!
! This routine is used in combination with lubksb 
! to solve linear equations or invert a matrix.
!
! Reference: Adapted from Numerical Recipes in Fortran
! Optimised by  J.Hague Sep 2009
! Bugfix R.Forbes/J.Hague Sep 2009
!-----------------------------------------------------------------------
USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

IMPLICIT NONE

! INPUT ARGUMENTS.
INTEGER(KIND=JPIM),INTENT(IN)  :: KN,KNP
INTEGER(KIND=JPIM),INTENT(IN)  :: KLON,KIDIA,KFDIA
INTEGER(KIND=JPIM),INTENT(OUT) :: KINDX(KLON,KN)
REAL(KIND=JPRB),INTENT(INOUT)  :: PARRAY(KLON,KNP,KNP)

! LOCAL VARIABLES.
INTEGER(KIND=JPIM) :: I,IMAX(KLON),J,IK,JL 
REAL(KIND=JPRB)    :: ZAAMAX(KLON),ZDUM(KLON),ZSUM(KLON),ZVV(KLON,KN)
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTINY, ZABS
PARAMETER (ZTINY=1.0E-20_JPRB) 

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

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


DO I=1,KN !LOOP OVER ROWS TO GET THE IMPLICIT SCALING INFORMATION. 

  DO JL=KIDIA,KFDIA
    ZAAMAX(JL) = 0.0_JPRB 
  ENDDO

  DO J=1,KN 
    DO JL=KIDIA,KFDIA
#ifdef RS6K
      ZABS       = ABS(PARRAY(JL,I,J))
      ZAAMAX(JL) = FSEL(ZABS-ZAAMAX(JL),ZABS,ZAAMAX(JL))
#else
      IF (ABS(PARRAY(JL,I,J)) > ZAAMAX(JL)) ZAAMAX(JL)=ABS(PARRAY(JL,I,J)) 
#endif
    ENDDO
  ENDDO

  DO JL=KIDIA,KFDIA
    IF (ZAAMAX(JL) <= 0.0_JPRB) THEN 
      CALL ABOR1('LUDCMP: Singular matrix')
    ENDIF ! SINGULAR MATRIX 
    ZVV(JL,I) = 1.0_JPRB/ZAAMAX(JL) !SAVE THE SCALING. 
  ENDDO
ENDDO 

DO J=1,KN 
! THIS IS THE LOOP OVER COLUMNS OF CROUT S METHOD. 
  DO I=1,J-1 !THIS IS EQUATION (2.3.12) EXCEPT FOR I = J. 
    DO JL=KIDIA,KFDIA
      ZSUM(JL) = PARRAY(JL,I,J) 
    ENDDO
    DO IK=1,I-1 
      DO JL=KIDIA,KFDIA
        ZSUM(JL) = ZSUM(JL)-PARRAY(JL,I,IK)*PARRAY(JL,IK,J) 
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      PARRAY(JL,I,J) = ZSUM(JL) 
    ENDDO
  ENDDO 
  DO JL=KIDIA,KFDIA
    ZAAMAX(JL) = 0.0_JPRB ! INITIALIZE FOR THE SEARCH FOR LARGEST PIVOT ELEMENT. 
    IMAX(JL)   = J
  ENDDO
  DO I=J,KN ! THIS IS I = J OF EQUATION (2.3.12) 
           ! AND I = J+1. . .KN OF EQUATION (2.3.13). 
    DO JL=KIDIA,KFDIA
      ZSUM(JL) = PARRAY(JL,I,J) 
    ENDDO
    DO IK=1,J-1 
      DO JL=KIDIA,KFDIA
        ZSUM(JL) = ZSUM(JL)-PARRAY(JL,I,IK)*PARRAY(JL,IK,J) 
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      PARRAY(JL,I,J) = ZSUM(JL)
      ZDUM(JL) = ZVV(JL,I)*ABS(ZSUM(JL))     ! FIGURE OF MERIT FOR THE PIVOT. 
      IF (ZDUM(JL) >= ZAAMAX(JL)) THEN ! IS IT BETTER THAN THE BEST SO FAR? 
        IMAX(JL)   = I 
        ZAAMAX(JL) = ZDUM(JL)
      ENDIF 
    ENDDO
  ENDDO
  DO IK=1,KN ! YES, DO SO... 
    DO JL=KIDIA,KFDIA
      IF (J /= IMAX(JL))THEN ! DO WE NEED TO INTERCHANGE ROWS?
        ZDUM(JL)              = PARRAY(JL,IMAX(JL),IK) 
        PARRAY(JL,IMAX(JL),IK) = PARRAY(JL,J,IK) 
        PARRAY(JL,J,IK)        = ZDUM(JL) 
      ENDIF
    ENDDO
  ENDDO
  DO JL=KIDIA,KFDIA
    IF (J /= IMAX(JL))THEN 
!     PEVEN=-PEVEN !...AND CHANGE THE PARITY OF D. 
      ZVV(JL,IMAX(JL)) = ZVV(JL,J) ! ALSO INTERCHANGE THE SCALE FACTOR. 
    ENDIF 
  ENDDO
  DO JL=KIDIA,KFDIA
    KINDX(JL,J) = IMAX(JL) 
!     IF(PARRAY(JL,J,J) == 0.0_JPRB) PARRAY(JL,J,J) = ZTINY
      IF(ABS(PARRAY(JL,J,J)) < ZTINY) PARRAY(JL,J,J) = ZTINY
  ENDDO
  IF(J /= KN)THEN
    DO JL=KIDIA,KFDIA
      ZDUM(JL) = 1.0_JPRB/PARRAY(JL,J,J)
    ENDDO
    DO I=J+1,KN
      DO JL=KIDIA,KFDIA
        PARRAY(JL,I,J) = PARRAY(JL,I,J)*ZDUM(JL)
      ENDDO
    ENDDO
  ENDIF 
ENDDO


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