cvsp_compress_brut.f

Go to the documentation of this file.

!                   ********************************
                    SUBROUTINE cvsp_compress_brut(J)
!                   ********************************
!
!
!***********************************************************************
! SISYPHE   V7P2                                   16/05/2017
!***********************************************************************
!
!brief    COMPRESSES A VERTICAL SORTING PROFILE IN POINT J TO PREVENT
!+        EXTENSIV GROTH OF SECTION / NODE NUMBERS
!+
!+        BRUTAL VERSION
!+        IN CASE OF EMERGENCY, IF NO OTHER ALGORITHM IS ALLOWED TO COMPRESS,
!+        TO PREVENT PRO_MAX_MAX OVERFLOW
!
!history UWE MERKEL
!+        23/12/2011
!+        V6P2
!+
!
!history PABLO TASSI PAT (EDF-LNHE)
!+        12/02/2013
!+        V6P3
!+ PREPARING FOR THE USE OF A HIGHER NSICLM VALUE
!+ (BY REBEKKA KOPMANN)
!+
!
!history  P. A. TASSI (EDF R&D, LNHE)
!+        12/03/2013
!+        V6P3
!+   Cleaning, cosmetic
!
!history  R. KOPMANN (BAW)
!+        25/02/2019 
!+        V7P2
!+   Removing 1/NSICLA
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| J              |<--| INDEX OF A POINT IN MESH
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe
      USE declarations_sisyphe
!
      USE declarations_special
      USE cvsp_outputfiles, ONLY: cp
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: J
      DOUBLE PRECISION Z_LOW ,Z_HIGH, SECHIGHT,DUMMY
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
! USING T1 INSTEAD, ASSUMING THAT NUMBER OF NODES ALWAYS BIGGER THAN NUMBER OF GRAIN SIZE CLASSES
!
      INTEGER NEWPRO_MAX, K, I, JG
      DOUBLE PRECISION H,L,M
      LOGICAL RET
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!TEMPORARY VERTICAL SORTING PROFILE: FRACTION + DEPTH FOR EACH LAYER, CLASS, POINT
!
      DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_FNEW
      DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_DNEW
!
!-----------------------------------------------------------------------
!
      ALLOCATE(pro_dnew(pro_max_max,nsicla))
      ALLOCATE(pro_fnew(pro_max_max,nsicla))

      jg = j
      IF(ncsize.GT.1) jg = mesh%KNOLG%I(j)
      IF(cvsp_db(jg,0)) CALL cvsp_p('./','BRUA',jg)
!
!-----------------------------------------------------------------------
! REMOVES NUMERIC INSTABILITIES
!-----------------------------------------------------------------------
      DO k = 1, pro_max(j)
        ret = cvsp_check_f(j,k,'BeforeBRUT:   ')
      ENDDO
      CALL cvsp_check_steady(j)
!
!-----------------------------------------------------------------------
! WORKS LIKE THE MAKE_ACT LAYER ROUTINE BUT FOR VSP
!-----------------------------------------------------------------------
!
      newpro_max=int(max(8.d0,(dble(pro_max_max - 4 * nsicla)*0.7d0)))
!
!-----------------------------------------------------------------------
! NEW VSP SECTION HEIGHT
!-----------------------------------------------------------------------
!
      h=pro_d(j,pro_max(j),1) !High
      l=pro_d(j,1,1)          !Low
      m=h-l                   !Mighty
!
!SECTION THICKNESS
      sechight = m / (newpro_max - 1)
      sechight = max(sechight,fdm(1))
      newpro_max=int(m/sechight+1)
      newpro_max=max(2,newpro_max)
      sechight = m / (newpro_max - 1)
!
!VERY THIN SECTION
      IF (m.LE.sechight) THEN
        newpro_max = 3
        z_low  = l
        z_high = h
        DO i = 1, nsicla
          pro_dnew(1,i) = l
          pro_dnew(2,i) = l
          pro_dnew(3,i) = h
        ENDDO
        IF (m.GT.0.d0) THEN
          dummy=cvsp_integrate_volume(j,1,z_high,z_low,t1%R)/
     &          (z_high-z_low)
          DO i = 1, nsicla
            pro_fnew(1,i) = t1%R(i) / sechight
            pro_fnew(2,i) = t1%R(i) / sechight
            pro_fnew(3,i) = t1%R(i) / sechight
          ENDDO
        ELSE
          DO i = 1, nsicla
            pro_fnew(1,i) = 0.d0
            pro_fnew(2,i) = 0.d0
            pro_fnew(3,i) = 0.d0
          ENDDO
        ENDIF
!
!     LESS THIN SECTIONS
      ELSE
        DO k = 1, newpro_max
          pro_dnew(k,1) = (k-1)*sechight + pro_d(j,1,1)
          z_low  = pro_dnew(k,1) - 0.5d0*sechight
          z_high = pro_dnew(k,1) + 0.5d0*sechight
          IF(k.EQ.1)  z_low = l
          IF(k.EQ.newpro_max) z_high = h
          dummy=cvsp_integrate_volume(j,1,z_high,z_low,t1%R)/
     &          sechight
          DO i = 1, nsicla
            pro_dnew(k,i) = (k-1)*sechight + pro_d(j,1,1)
            IF (z_high-z_low.LE.zero) THEN
              pro_fnew(k,i) = 0.d0
            ELSE
              pro_fnew(k,i) = t1%R(i) / sechight
            ENDIF
!
!           UPPER AND LOWER SECTIONS ARE ONLY HALF STRENGTH
            IF(k.EQ.1) pro_fnew(k,i) = pro_fnew(k,i)*2
            IF(k.EQ.newpro_max) pro_fnew(k,i) = pro_fnew(k,i)*2
            IF (pro_fnew(k,i).GE.1.0d0) THEN
              IF(cp) print*,'JKI,F,SECHIGHT,M,NEWPMAX',
     &        j,k,i,pro_fnew(k,i),sechight,m,newpro_max
              IF(cp) print*,'L,H,Z_LOW,Z_HIGH',
     &        l,h,z_low,z_high,t1%R(1),t1%R(2)
            ENDIF
          ENDDO
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
! RESUBSTITUTE
!-----------------------------------------------------------------------
!
      DO i = 1, nsicla
        DO k = 1, newpro_max
          pro_d(j,k,i) = pro_dnew(k,i)
          pro_f(j,k,i) = pro_fnew(k,i)
        ENDDO
      ENDDO
!
      pro_max(j) = newpro_max
!
      IF(pro_max(j).LE.2) THEN
        WRITE(lu,*) ' COMPRESSBRUT: NOT ENOUGH PRO_MAX '
        CALL plante(1)
        stop
      ENDIF
!
      IF(cvsp_db(jg,0)) CALL cvsp_p('./','BRUE',jg)
!
!-----------------------------------------------------------------------
!
      DEALLOCATE(pro_dnew)
      DEALLOCATE(pro_fnew)
!
!-----------------------------------------------------------------------
! REMOVES NUMERIC INSTABILITIES
!-----------------------------------------------------------------------
!
      CALL cvsp_check_steady(j)
      ret = .true.
      DO k = 1, pro_max(j)
        ret = cvsp_check_f(j,k,'AFTERBRUT:   ')
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE cvsp_compress_brut