choldc.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
SUBROUTINE choldc(N,A,P)

USE modi_abor1_sfx

USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb

 IMPLICIT NONE

 INTEGER, INTENT(IN) :: n
 REAL, DIMENSION(N,N), INTENT(INOUT) :: a
 REAL, DIMENSION(N), INTENT(OUT) :: p
 INTEGER :: i
 REAL :: summ
 REAL(KIND=JPRB) :: zhook_handle

 IF (lhook) CALL dr_hook('CHOLDC',0,zhook_handle)
 DO i=1,n

   summ = a(i,i)- dot_product(a(i,1:i-1),a(i,1:i-1))

   IF (summ <= 0.0) CALL abor1_sfx("CHOLDC:ERROR IN CHOLDC")

   p(i) = sqrt(summ) 
   a(i+1:n,i) = (a(i,i+1:n) - matmul(a(i+1:n,1:i-1),a(i,1:i-1)))/p(i)

 ENDDO

 IF (lhook) CALL dr_hook('CHOLDC',1,zhook_handle)

END SUBROUTINE choldc