disimp.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE disimp
!                   *****************
!
     &(q,q2bor,numliq,ifrliq,nsoldis,work1,qbor,nptfr,mask,mesh)
!
!***********************************************************************
! SISYPHE   V6P2                                   24/07/2012
!***********************************************************************
!
!brief    Imposes solid discharge boundary conditions. Q2BOR is the
!+        discharge in m2/s, the integral of Q2BOR on the boundary QBOR
!+        is multiplied by a constant to get the correct discharge Q
!
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        24/07/2012
!+        V6P2
!+
!
!history  J,RIEHME (ADJOINTWARE)
!+        November 2016
!+        V7P2
!+   Replaced EXTERNAL statements to parallel functions / subroutines
!+   by the INTERFACE_PARALLEL
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IFRLIQ         |-->| RANK OF LIQUID BOUNDARY
!| MASK           |-->| BLOCK OF MASKS FOR BOUNDARY CONDITIONS
!| MESH           |-->| MESH STRUCTURE
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| NSOLDIS        |-->| NUMBER OF SOLID DISCHARGES GIVEN IN PARAMETER
!|                |   | FILE
!| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
!| Q              |-->| PRESCRIBED VALUE OF DISCHARGE
!| Q2BOR          |<--| PRESCRIBED SOLID DISCHARGE
!| RATIO          |<--| RATIO, QBOR WILL BE RATIO*Q2BOR
!| WORK1          |<->| WORK BIEF_OBJ STRUCTURE
!| QBOR           |<->| THE RESULTING DISCHARGE IN M3/S
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
!
      USE declarations_special
      USE interface_parallel, ONLY : p_dsum
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: NPTFR,IFRLIQ,NSOLDIS
      INTEGER, INTENT(IN)             :: NUMLIQ(nptfr)
      DOUBLE PRECISION, INTENT(IN)    :: MASK(nptfr),Q
      TYPE(bief_mesh), INTENT(INOUT)  :: MESH
      TYPE(bief_obj), INTENT(INOUT)   :: WORK1,QBOR
      TYPE(bief_obj), INTENT(IN)      :: Q2BOR
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER K,IELM
!
      DOUBLE PRECISION Q1
!
      INTRINSIC abs
!
!=======================================================================
!     COMPUTES FLUX
!=======================================================================
!
!     IN THE FOLLOWING LOOP ONE RESTRICTS THE MASK OF DIRICHLETS SEGMENTS
!     TO THOSE OF THE LIQUID BOUNDARY NUMBER IFRLIQ. AS NUMLIQ IS
!     DEFINED AT NODES, ONE RISKS AN ERROR FOR THE SEGMENT FOLLOWING
!     THE LAST NODE ON THE BOUNDARY. IN FACT THIS SEGMENT WILL BE SOLID
!     AND WILL HAVE A MASK ALREADY SET TO ZERO.
!
      DO k=1,nptfr
        IF(numliq(k).EQ.ifrliq) THEN
          work1%R(k)=mask(k)
        ELSE
          work1%R(k)=0.d0
        ENDIF
      ENDDO
!
!     Q2BOR IS INTEGRATED ALONG THE BOUNDARY
!
      ielm=11
      CALL vector(qbor,'=','MASVEC          ',ielbor(ielm,1),
!                      USED  VOID  VOID  VOID  VOID  VOID
     &            1.d0,q2bor,q2bor,q2bor,q2bor,q2bor,q2bor,
     &            mesh,.true.,work1)
!
!=======================================================================
!     FINAL QBOR IF Q2BOR ONLY A PROFILE
!=======================================================================
!
      IF(nsoldis.GE.ifrliq) THEN
!
!       A VALUE OF DISCHARGE HAS BEEN GIVEN IN THE PARAMETER FILE
!       FOR THIS BOUNDARY. Q2BOR IS CONSIDERED AS ONLY A PROFILE
!
!       FOR THE USER: POSITIVE DISCHARGE = ENTERING
        q1 = bief_sum(qbor)
        IF(ncsize.GT.1) q1 = p_dsum(q1)
!
        IF(abs(q1).LT.1.d-10) THEN
!         ZERO FLUX: WARNING MESSAGE
          IF(abs(q).GT.1.d-10) THEN
            WRITE(lu,31) ifrliq
31          FORMAT(1x,'DISIMP : PROBLEM ON BOUNDARY NUMBER ',1i6,/,1x,
     &     '           GIVE A SOLID DISCHARGE PROFILE  ',/,1x,
     &     '           IN THE BOUNDARY CONDITIONS FILE')
            CALL plante(1)
            stop
          ELSE
            q1 = 1.d0
          ENDIF
        ENDIF
!
        DO k=1,nptfr
          IF(numliq(k).EQ.ifrliq) THEN
            qbor%R(k) = qbor%R(k) * q / q1
          ENDIF
        ENDDO
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END