cvsp_check_l.f

Go to the documentation of this file.

!           *****************************
            RECURSIVE FUNCTION cvsp_check_l
!           *****************************
!
     &(j,k, sometext) result(ret)
!
!***********************************************************************
! SISYPHE   V7P2                                   16/05/2017
!***********************************************************************
!
!brief   CHECKS IF SUM OF FRACTIONS = 1 FOR
!+        A LAYER
!
!history UWE MERKEL, R. KOPMANN (BAW)
!+        19/08/2016 / 2017
!+        V6P3 / V7P2
!
!history  R. KOPMANN (BAW)
!+        25/02/2019
!+        V7P2
!+   Removing 1/NSICLA
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| J              |<--| INDEX OF A POINT IN MESH
!| K              |<--| INDEX OF A LAYER
!| SOMETEXT       |<--| DEBUGING TEXT FOR LOG-OUTPUT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def, ONLY: ncsize
      USE bief
      USE declarations_sisyphe
      USE cvsp_outputfiles, ONLY: cp
      USE declarations_special
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,          INTENT(IN)    :: J
      INTEGER,          INTENT(IN)    :: K
      CHARACTER(LEN=10),INTENT(IN) :: SOMETEXT
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION ASUM, AT
      INTEGER I, JG
      LOGICAL RET
!
!-----------------------------------------------------------------------
!
      at = dt*lt/percou
      jg = j
      IF (ncsize > 1) jg = mesh%KNOLG%I(j)
!
      ret = .true.

      asum = 0.d0
!
!-----------------------------------------------------------------------
!SUM UP AND SLIGHT CORRECTION
!-----------------------------------------------------------------------
!
      DO i=1,nsicla
        asum = avail(j,k,i) + asum
        IF ((avail(j,k,i)>1.d0+zero)) THEN
          IF(cp) WRITE(lu,*)
     &      'CVSP CL: AVAIL>1: WARN,LT,Pnt_J;Lay_K;F_I;%: '
     &      ,sometext,lt,jg,k,i,pro_f(j,k,i)
        ENDIF
!
        IF ((avail(j,k,i)<0.d0-zero)) THEN
          IF(cp) WRITE(lu,*)
     &      'CVSP CL: AVAIL<0: WARN,LT,Pnt_J;Lay_K;F_I;%: '
     &      ,sometext,lt,jg,k,i,pro_f(j,k,i)
        ENDIF
      ENDDO
!
      IF (abs(asum-1.0d0)>zero.AND.asum.GT.0.d0) THEN
        IF ((abs(asum-1.0d0)>1.d-6).AND.(asum.GT.0.d0)) THEN
          DO i=1,nsicla
            avail(j,k,i) = avail(j,k,i) / asum
          END DO
          IF (lt.GT.0) THEN
            IF(cp) WRITE(lu,*)
     &          'CVSP CL: |SUM_ERR|: WARN,LT,J;K;SUM: '
     &          ,sometext,lt,jg,k,asum
          ret = .false.
          ENDIF
        ENDIF
      END IF


      IF (abs(asum)<zero.AND.asum.GT.0.d0) THEN
!         WRITE(LU,*) 'CVSP CL: |SUM_ZERO|: WARN,LT,Pnt_J;Lay_K;F_I;SUM:'
!     &                  ,SOMETEXT,LT,JG,K,I,ASUM
        DO i=1,nsicla
            avail(j,k,i) = 0.d0
        END DO
        ret = .false.
      END IF
!
!-----------------------------------------------------------------------
!
        IF (ret.EQV..false.) THEN
          ret = cvsp_check_l(j,k,'ReCheck   ')
        ENDIF
!
!-----------------------------------------------------------------------
      RETURN
      END FUNCTION cvsp_check_l