cvsp_check_f.f

Go to the documentation of this file.

!                   *****************************
                    RECURSIVE FUNCTION cvsp_check_f
!                   *****************************
!
     &(j,k, sometext) result(ret)
!
!***********************************************************************
! SISYPHE   V7P2                                   16/05/2017
!***********************************************************************
!
!brief   CHECKS IF SUM OF FRACTIONS = 1 FOR
!+        A SECTION IN THE VERTICAL SORTING PROFILE
!
!history UWE MERKEL
!+        19/08/2011
!+        V6P2
!+
!
!history  P. A. TASSI (EDF R&D, LNHE)
!+        12/03/2013
!+        V6P3
!+   Cleaning, cosmetic
!
!history UWE MERKEL, R. KOPMANN (BAW)
!+        19/08/2016 / 2017
!+        V6P3 / V7P2
!+        many changes!
!
!history R. KOPMANN (BAW)
!+        25/02/2019
!+        V7P2
!+        inserting check PRO_F>1, removing 1/NSICLA
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| J              |<--| INDEX OF A POINT IN MESH
!| K              |<--| INDEX OF A SECTION IN VERTICAL SORTING PROFILE
!| 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 TEMP, AT, ERRTOCORR
      INTEGER I, JG
      LOGICAL RET
!-----------------------------------------------------------------------
      at = dt*lt/percou
      jg = j
      IF (ncsize > 1) jg = mesh%KNOLG%I(j)
      ret = .true.
      temp = 0.d0
!-----------------------------------------------------------------------
!SUM UP AND SLIGHT CORRECTION
!-----------------------------------------------------------------------
      DO i=1,nsicla
        IF (pro_f(j,k,i).LT.0.d0) THEN
          IF (pro_f(j,k,i).LE.-1.d-7.AND.cp) WRITE(lu,*)
     &     'CVSP CF:PRO_F<0: WARN,J;K;F_I;%: ',
     &     sometext,jg,k,i,pro_f(j,k,i)
          IF(pro_f(j,k,i).GE.-1.d-3) THEN
            pro_f(j,k,i) = 0.d0
          ELSE
            CALL cvsp_p('./','PRO_F.lt'//sometext, j)
            WRITE(lu,*) 'CVSP CF:PRO_F<0: ERR,LT,J;K;F_I;%: '
     &                 ,sometext,lt,jg,k,i,pro_f(j,k,i)
            CALL plante(1)
            stop
          ENDIF
        ENDIF
!RK PRO_F > 1
        IF (pro_f(j,k,i).GT.1.d0) THEN
          IF ((1.d0-pro_f(j,k,i)).LE.-1.d-7.AND.cp) WRITE(lu,*)
     &     'CVSP CF:PRO_F>1: WARN,J;K;F_I;%: ',
     &     sometext,jg,j,k,i,pro_f(j,k,i)
!          IF((1.D0-PRO_F(J,K,I)).GE.-1.D-3) THEN
! This barrier is quite low, as it is a numerical problem in rm_fraction
! if a fraction of value nearly 1 is removed than the "normalising procedure" is not very
! precise as it is diveded by (1-reomoved fraction) which can be nearly zero...
          IF((1.d0-pro_f(j,k,i)).GE.-1.d0) THEN
            pro_f(j,k,i) = 1.d0
          ELSE
            CALL cvsp_p('./','PRO_F.gt'//sometext, j)
            WRITE(lu,*) 'CVSP CF:PRO_F>1: ERR,LT,J;K;F_I;%: '
     &                 ,sometext,lt,jg,k,i,pro_f(j,k,i),pro_max(j)
            CALL plante(1)
            stop
          ENDIF
        ENDIF
        temp = temp + pro_f(j,k,i)
      ENDDO
! ALL FRACTION ZERO IS OK, IN CVSP_MAIN this section will be deleted
      IF(temp.EQ.0.d0) THEN
        temp = 1.d0
      ENDIF
!-----------------------------------------------------------------------
! CHECK AND CORRECT DEVIATIONS
!-----------------------------------------------------------------------
      IF(abs(temp-1.d0).GT.0.d0) THEN
        IF(abs(temp).LT.1.d-6) THEN
!         SEVERE ERROR, FOR DEBUGGING ONLY RESET to 1 / NSICLA
          IF(cp) WRITE(lu,*) 'CVSP CF: |SUM_ERR|~0;LT;J;K;SUM:'
     &                  ,sometext,lt,jg,k,temp
          ret = .false.
          IF(cp) WRITE(lu,*) 'CVSP  --> NSICLA: ', nsicla
          DO i=1,nsicla
            IF(cp) WRITE(lu,*) 'CVSP  --> ;LT;Pnt_J;Lay_K;F_I,%: '
     &                 ,lt,jg,k,i,pro_f(j,k,i)
            pro_f(j,k,i) = 0.d0
          ENDDO
        ELSEIF(abs(temp-1.d0).GT.1.d-6) THEN
!STRONG DIFFERENCES ARE CORRECTED BY NORMALIZING ALL FRACTIONS
!!!!!!!!!!! README!
!The following warning occured in 0.00025 of all cases
!In almost every case |SUM_ERR| < 2*1.D-5
!To remove this remaining errors would cost 2-3 times higher
!computational expense with no significant global effects
!So the following warning is just meant to remember you on truncation errors
!that still exist
          IF(abs(temp-1.d0).GT.5.d-5) THEN
            IF(cp) WRITE(lu,*) 'CVSP CF: |SUM_ERR|>1.-5 ;LT;J;K;SUM:'
     &                  ,sometext,lt,jg,k,temp
          ENDIF
          ret = .false.
          DO i=1,nsicla
            IF(pro_f(j,k,i).GT.0.d0) THEN
              pro_f(j,k,i) = pro_f(j,k,i) / temp
            ENDIF
          ENDDO
        ELSE
! SLIGHT DIFFERENCES TO 0 ARE CORRECTED BY CHANGING ONLY
! THE FIRST FRACTION BIG ENOUGH
          errtocorr = 1.d0-temp
          DO i=1,nsicla
            IF(pro_f(j,k,i)+errtocorr.GT.0.d0.AND.
     &        pro_f(j,k,i)+errtocorr.LE.1.d0 ) THEN
              pro_f(j,k,i) = pro_f(j,k,i) + errtocorr
              EXIT
            ENDIF
          ENDDO
        ENDIF
      ENDIF
!-----------------------------------------------------------------------
! RECHECK
!-----------------------------------------------------------------------
      IF(ret .EQV. .false.) THEN
        ret = cvsp_check_f(j,k,'ReCheck   ')
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END FUNCTION cvsp_check_f