fill_lim.f

Go to the documentation of this file.

!                       *******************
                        SUBROUTINE fill_lim
!                       *******************
!
     & (nptfr,nptfrx,ntrac,lihbor,liubor,livbor,litbor,
     &  hbor,ubor,vbor,chbord,tbor,atbor,btbor, nbor, old_nbor)
!
!***********************************************************************
! PROGICIEL : STBTEL  V5.2                 J-M JANIN   (LNH) 30 87 72 84
! ORIGINE   : TELEMAC
!***********************************************************************
!
!     FUNCTION  :  FILLS THE BOUNDARY CONDITIONS ARRAYS BASED ON THE
!                  COARSER MESH INFORMATION
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! | HBOR           | <->| PRESCRIBED DEPTH
! | LIHBOR         | -->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
! | LITBOR         | -->| TYPE OF BOUNDARY CONDITIONS ON TRACERS
! | LIUBOR         | -->| TYPE OF BOUNDARY CONDITIONS ON VELOCITY
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
! APPELE PAR : STBTEL
!***********************************************************************
!
      USE bief
      USE declarations_special
      IMPLICIT NONE

      INTEGER, INTENT(IN)    :: NPTFR,NPTFRX,NTRAC
      INTEGER,INTENT(INOUT) :: LIHBOR(nptfrx),LIUBOR(nptfrx)
      INTEGER,INTENT(INOUT) :: LIVBOR(nptfrx)
      TYPE(bief_obj)  , INTENT(INOUT) :: LITBOR
      DOUBLE PRECISION, INTENT(INOUT) :: UBOR(nptfrx,2),VBOR(nptfrx,2)
      DOUBLE PRECISION, INTENT(INOUT) :: HBOR(nptfrx)
      DOUBLE PRECISION, INTENT(INOUT) :: CHBORD(nptfrx)
      TYPE(bief_obj)  , INTENT(INOUT) :: TBOR, ATBOR, BTBOR
      INTEGER, INTENT(IN) :: NBOR(nptfrx), OLD_NBOR(nptfrx)

      INTEGER I, P1, P2
      INTEGER VAL_P1, VAL_P2, IDX

      LOGICAL :: REORDER, FOUND
      INTEGER, ALLOCATABLE :: CONV(:)
      INTEGER J, NODE

      ! Check if the nbor of the original mesh has the same oredering as
      ! the one in the refine mesh that went through ranbo
      reorder = .false.
      DO i=1,nptfr
        IF (old_nbor(i) .NE. nbor(2*i-1)) THEN
          reorder = .true.
          EXIT
        ENDIF
      ENDDO

      ALLOCATE(conv(nptfr))

      IF (reorder) THEN
        DO i=1,nptfr
          node = nbor(2*i-1)
          found = .false.
          DO j=1,nptfr
            IF (old_nbor(j).EQ.node) THEN
              found = .true.
              EXIT
            ENDIF
          ENDDO
          conv(i) = j
        ENDDO
      ELSE
        DO i=1,nptfr
          conv(i) = i
        ENDDO
      ENDIF
!

      ! Setting all odd value to the not refined value (this is valid
      ! because fo the reodering and the fact that each boundary segment
      ! is split in two)
      ! Using usb array ensure that we first read all the values and
      ! then copy them

      lihbor(1:nptfr*2:2)=lihbor(conv)
      liubor(1:nptfr*2:2)=liubor(conv)
      livbor(1:nptfr*2:2)=livbor(conv)

      chbord(1:nptfr*2:2)=chbord(conv)
      hbor(1:nptfr*2:2)=hbor(conv)
      ubor(1:nptfr*2:2,1)=ubor(conv,1)
      vbor(1:nptfr*2:2,1)=vbor(conv,1)
      ubor(1:nptfr*2:2,2)=ubor(conv,2)
      vbor(1:nptfr*2:2,2)=vbor(conv,2)

      IF (ntrac.GT.0) THEN
        litbor%ADR(1)%P%I(1:nptfr*2:2)=litbor%ADR(1)%P%I(conv)
        atbor%ADR(1)%P%R(1:nptfr*2:2)=atbor%ADR(1)%P%R(conv)
        btbor%ADR(1)%P%R(1:nptfr*2:2)=btbor%ADR(1)%P%R(conv)
      ENDIF

      DEALLOCATE(conv)
!
      ! Filling the point in the middle of each segment
      DO i=1,nptfr

        p1 = 2*i-1
        p2 = 2*i+1
        IF(i.EQ.nptfr) THEN
          p2 = 1
        ENDIF
!
        val_p1 = lihbor(p1)*1000 +
     &           liubor(p1)*100  +
     &           livbor(p1)*10
        IF(ntrac.GT.0) THEN
          val_p1 = val_p1 + litbor%ADR(1)%P%I(p1)*1
        ENDIF

        val_p2 = lihbor(p2)*1000 +
     &           liubor(p2)*100  +
     &           livbor(p2)*10
        IF(ntrac.GT.0) THEN
          val_p2 = val_p2 + litbor%ADR(1)%P%I(p2)*1
        ENDIF

        ! If same type on each point apply the same type
        IF (val_p1.EQ.val_p2) THEN
          idx = p1
        ! If one of the points is a solid point taking that one
        ELSE IF(lihbor(p1).EQ.2) THEN
          idx = p1
        ELSEIF(lihbor(p2).EQ.2) THEN
          idx = p2
        ! Otherwise taking the smallest one
        ELSEIF(val_p1.LT.val_p2) THEN
          idx = p1
        ELSE
          idx = p2
        ENDIF

        lihbor(2*i)=lihbor(idx)
        liubor(2*i)=liubor(idx)
        livbor(2*i)=livbor(idx)
        chbord(2*i)=chbord(idx)
        hbor(2*i)=hbor(idx)
        ubor(2*i,1)=ubor(idx,1)
        vbor(2*i,1)=vbor(idx,1)
        ubor(2*i,2)=ubor(idx,2)
        vbor(2*i,2)=vbor(idx,2)
!
        IF(ntrac.GT.0) THEN
          litbor%ADR(1)%P%I(2*i)=litbor%ADR(1)%P%I(idx)
          atbor%ADR(1)%P%R(2*i)=atbor%ADR(1)%P%R(idx)
          btbor%ADR(1)%P%R(2*i)=btbor%ADR(1)%P%R(idx)
        ENDIF
!
      ENDDO
!
      END SUBROUTINE