cvsp_add_fraction.f

Go to the documentation of this file.

!                   ****************************
                    SUBROUTINE cvsp_add_fraction
!                   ****************************
!
     &(j, i, dzfcl)
!
!***********************************************************************
! SISYPHE   V6P3                                   12/03/2013
!***********************************************************************
!
!brief    ADDS A FRACTION TO THE TOPMOST VERTICAL SORTING PROFILE SECTION
!
!history  UWE MERKEL
!+        2011
!+        V6P2
!+
!
!history  P. A. TASSI (EDF R&D, LNHE)
!+        12/03/2013
!+        V6P3
!+   Cleaning, cosmetic
!
!
!history  R. KOPMANN (BAW)
!+        25/02/2019
!+        V7P2
!+  Considering a new case: only 1 fraction occurs, must have value 1
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| J              |<--| INDEX OF A POINT IN MESH
!| I              |<--| INDEX OF A FRACTION
!| DZFCL          |<--| EVOLUTION OF FRACTION I [M]
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_sisyphe
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,          INTENT(IN) :: J
      INTEGER,          INTENT(IN) :: I
      DOUBLE PRECISION, INTENT(IN) :: DZFCL
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION STR_OLD, STR_NEW, TEMP1, TEMP2, AT
      DOUBLE PRECISION SUMF, SUMF2
      INTEGER II
      LOGICAL RET, CVSP_CHECK_F
!
!-----------------------------------------------------------------------
!
      at = dt*lt/percou
!
!-----------------------------------------------------------------------
!     MAKES SURE THAT THERE IS NO INFLUENCE ON THE PROFILE POINTS BELOW
!     BY INSERTING A SECTION WITH 0 STRENGTH IF IT DOESN'T EXIST ALREADY
!
!     CHECKS FOR BREAKPOINT (= 0 STRENGTH)
!-----------------------------------------------------------------------
!
      IF (pro_max(j).GT.2) THEN
        IF (pro_d(j,pro_max(j)-1,1).GT.pro_d(j,pro_max(j)-2,1)) THEN
!
!-----------------------------------------------------------------------
!INSERT
!-----------------------------------------------------------------------
!
          pro_max(j) = pro_max(j) + 1
!
!-----------------------------------------------------------------------
!SHIFTS BREAKPOINT
!-----------------------------------------------------------------------
!
          DO ii=1,nsicla
            pro_f(j,pro_max(j),ii) = pro_f(j,pro_max(j)-1,ii)
            pro_f(j,pro_max(j)-1,ii) = pro_f(j,pro_max(j)-2,ii)
            pro_d(j,pro_max(j),ii) = pro_d(j,pro_max(j)-1,ii)
            pro_d(j,pro_max(j)-1,ii) = pro_d(j,pro_max(j)-2,ii)
          ENDDO

        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
! ADDS MATERIAL
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!STRENGTH OF FRACTION
!-----------------------------------------------------------------------
!
      str_old = (pro_d(j,pro_max(j),i)-pro_d(j,pro_max(j)-1,i))
      str_new = dzfcl + str_old
!
!-----------------------------------------------------------------------
!NEW FRACTIONS
!TOP
!-----------------------------------------------------------------------
!
      pro_f(j,pro_max(j),i) =
     &     (dzfcl + pro_f(j,pro_max(j),i) * str_old) / (str_new)
!
!-----------------------------------------------------------------------
!BOTTOM
!-----------------------------------------------------------------------
!
      pro_f(j,pro_max(j)-1,i) =
     &     (dzfcl + pro_f(j,pro_max(j)-1,i) * str_old) / (str_new)
!
!-----------------------------------------------------------------------
!NEW DEPTH=Z OF FRACTION
!-----------------------------------------------------------------------
!
      pro_d(j,pro_max(j),i) = dzfcl + pro_d(j,pro_max(j),i)
!
!-----------------------------------------------------------------------
!SHIFTING PERCENTAGE FOR THE OTHER FRACTIONS
!-----------------------------------------------------------------------
!
      sumf = 0.d0
      sumf2 = 0.d0
      DO ii=1,nsicla
        IF (i /= ii) THEN
!
!-----------------------------------------------------------------------
! SUM OF FRACTIONS AFTER SEDIMENTATION /= I
!-----------------------------------------------------------------------
!
          temp1 = pro_f(j,pro_max(j),ii) * str_old / str_new
          temp2 = pro_f(j,pro_max(j)-1,ii) * str_old / str_new
!
!-----------------------------------------------------------------------
! ASSIGN NEW THICKNESS & CORRECTED FRACTIONS
!-----------------------------------------------------------------------
!
          pro_f(j,pro_max(j),ii) = temp1
          pro_d(j,pro_max(j),ii) = dzfcl + pro_d(j,pro_max(j),ii)
          pro_f(j,pro_max(j)-1,ii) = temp2
          sumf = sumf + temp1
          sumf2 = sumf2 + temp2
        ENDIF
      ENDDO
      IF(sumf.EQ.0.d0) THEN
        pro_f(j,pro_max(j),i) = 1.d0
      ENDIF

      IF(sumf2.EQ.0.d0) THEN
        pro_f(j,pro_max(j)-1,i) = 1.d0
      ENDIF
!
!-----------------------------------------------------------------------
! REMOVES FLOATING POINT TRUCATIONS
!-----------------------------------------------------------------------
!
      ret = cvsp_check_f(j,pro_max(j),'ADF: MAX  ')
      ret = cvsp_check_f(j,pro_max(j)-1,'ADF: MAX+1')
      IF (pro_max(j).GT.2) THEN
        ret =  cvsp_check_f(j,pro_max(j)-2,'ADF: MAX+2')
      ENDIF
      IF (pro_max(j).GT.3) THEN
        ret = cvsp_check_f(j,pro_max(j)-3,'ADF: MAX+3')
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE cvsp_add_fraction