leclim.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE leclim
!                   *****************
!
     &(lihbor,liubor,livbor,litbor,hbor,ubor,vbor,tbor,
     & chbord,atbor,btbor,nptfr,code,trac,fformat,ngeo,
     & kent,kentu,ksort,kadh,klog,kinc,numliq,mesh,boundary_colour,
     & nptfr2)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    READS THE BOUNDARY CONDITIONS FILE AND
!+                STORES IN ARRAYS THE DATA READ.
!
!history  J-M HERVOUET (LNHE)
!+        09/07/2009
!+        V6P0
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Modification to comply with the hermes module
!
!history  J. GRASSET (Daresbury Lab & EDF)
!+        01/05/2018
!+        Add code for managing concatenated mesh
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
!| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
!| LIVBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON V
!| LITBOR         |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
!| HBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON DEPTH
!| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
!| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
!| TBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
!| CHBORD         |<--| FRICTION COEFFICIENT AT BOUNDARY
!| ATBOR,BTBOR    |<--| THERMAL EXCHANGE COEFFICIENTS.
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| CODE           |-->| 3 LETTER NAME OF THE CODE
!| TRAC           |-->| IF YES, THERE ARE TRACERS
!| FFORMAT        |-->| FILE FORMAT
!| NGEO           |-->| LOGICAL UNIT OF BOUNDARY CONDITIONS FILE
!| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
!| KENTU          |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VELOCITY
!| KSORT          |-->| CONVENTION FOR FREE OUTPUT
!| KADH           |-->| CONVENTION FOR NO SLIP BOUNDARY CONDITION
!| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
!| KINC           |-->| CONVENTION FOR INCIDENT WAVE BOUNDARY CONDITION
!| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
!| MESH           |-->| MESH STRUCTURE
!| BOUNDARY_COLOUR|<--| COLOUR OF BOUNDARY POINT (DEFAULT: ITS RANK)
!| NPTFR2         |-->| NUMBER OF QUADRATIC BOUNDARY POINTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_leclim => leclim
      USE interface_hermes
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)    :: NGEO,KENT,KSORT,KADH,KLOG,KINC,KENTU
      INTEGER, INTENT(IN)    :: NPTFR
      LOGICAL, INTENT(IN)    :: TRAC
      INTEGER, INTENT(INOUT) :: NUMLIQ(*)
      INTEGER, INTENT(INOUT) :: LIUBOR(nptfr),LIVBOR(nptfr)
      INTEGER, INTENT(INOUT) :: LIHBOR(nptfr),LITBOR(*)
      DOUBLE PRECISION,  INTENT(INOUT) :: UBOR(*),VBOR(*)
      DOUBLE PRECISION,  INTENT(INOUT) :: HBOR(nptfr),CHBORD(nptfr)
      DOUBLE PRECISION,  INTENT(INOUT) :: TBOR(*),ATBOR(*)
      DOUBLE PRECISION,  INTENT(INOUT) :: BTBOR(*)
      TYPE(bief_mesh),   INTENT(INOUT) :: MESH
      CHARACTER(LEN=3),  INTENT(IN) :: CODE
      CHARACTER(LEN=8),  INTENT(IN) :: FFORMAT
      INTEGER, OPTIONAL, INTENT(INOUT) :: BOUNDARY_COLOUR(nptfr)
      INTEGER, OPTIONAL, INTENT(IN)    :: NPTFR2
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER NPTFR_BND, I, IERR, K
      INTEGER, ALLOCATABLE :: BOUNDARY_COLOUR2(:)
      INTEGER :: DIMUBOR, TYPE_BND_ELEM, NDP_BND, NELEBD
!
      CHARACTER(LEN=11) :: EXTENS
      EXTERNAL extens
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      type_bnd_elem = mesh%TYPELMBND
      dimubor = nptfr
      IF(PRESENT(nptfr2)) dimubor = nptfr2
      CALL get_bnd_npoin(fformat,ngeo,type_bnd_elem,nptfr_bnd,ierr)
      CALL check_call(ierr,'LECLIM:GET_BND_NPOIN')
      ! Test difference between nptfr and nptfr_bnd
      IF(nptfr.NE.nptfr_bnd) THEN
        WRITE(lu,24) nptfr_bnd,nptfr
24      FORMAT(1x,'LECLIM: ERROR IN THE BOUNDARY CONDITIONS FILE,',
     &       /,9x,1i5,' LINES INSTEAD OF ',i5,' REQUESTED')
        CALL plante(1)
        stop
      ENDIF
      !
      CALL get_bnd_nelem(fformat,ngeo,type_bnd_elem,nelebd,ierr)
      CALL check_call(ierr,'LECLIM:GET_BND_NPOIN')

      CALL get_nodes_per_element(type_bnd_elem,ndp_bnd)
      ! Get nbor
      ! Only reading nbor from mesh in serial (because of renumbering)
      ! In parallel it will be read by read_partel_info
      IF(ncsize.LE.1) THEN
        CALL get_bnd_numbering(fformat,ngeo,type_bnd_elem,nptfr_bnd,
     &                    mesh%NBOR%I,ierr)
        IF(PRESENT(boundary_colour)) THEN
          CALL get_bnd_color(fformat,ngeo,type_bnd_elem,nptfr_bnd,
     &                       boundary_colour,ierr)
          CALL check_call(ierr,'LECLIM:GET_BND_COLOR')
        ENDIF
      ELSE
        ALLOCATE(boundary_colour2(nptfr),stat=ierr)
        CALL check_allocate(ierr,'LECLIM:BOUNDARY_COLOUR2')
!
        CALL read_partel_info(code,nptfr,numliq,boundary_colour2,
     &                        mesh)
!
        IF(PRESENT(boundary_colour)) THEN
          DO i=1,nptfr
            boundary_colour(i) = boundary_colour2(i)
          ENDDO
        ENDIF
        DEALLOCATE(boundary_colour2)
      ENDIF
      ! Get value of each boundary conditions
      CALL get_bnd_value(fformat,ngeo,type_bnd_elem,nelebd,
     & lihbor,liubor,livbor,hbor,ubor,vbor,chbord,trac,
     & litbor,tbor,atbor,btbor,nptfr_bnd,ierr)
      CALL check_call(ierr,'LECLIM:GET_BND_VALUE')
!
      DO k=1,nptfr
!
!       ADHERENCE FOR H CHANGED AT THE WALL
!
        IF(lihbor(k).EQ.kadh) THEN
          lihbor(k)=klog
          WRITE(lu,52) k
52        FORMAT(1x,'LECLIM : ADHERENCE SUR LA HAUTEUR AU POINT ',1i6,
     &              '         CHANGEE EN CONDITION DE PAROI')
        ENDIF
!
!       INCIDENT WAVE FOR H TREATED LIKE A FREE EXIT
!
        IF(lihbor(k).EQ.kinc) THEN
          lihbor(k)=ksort
        ENDIF
!
!       CANCELS DIRICHLET VALUES WHEN THE POINT IS NOT DIRICHLET
!       FOR POINTS WITH ADHERENCE, NEEDS UBOR OR VBOR =0
!
        IF(liubor(k).NE.kent.AND.liubor(k).NE.kentu) ubor(k)=0.d0
        IF(livbor(k).NE.kent.AND.livbor(k).NE.kentu) vbor(k)=0.d0
!
!       BACKS UP UBOR AND VBOR ON THEIR SECOND DIMENSION
!
        ubor(k+dimubor) = ubor(k)
        vbor(k+dimubor) = vbor(k)
!
      ENDDO ! K
!
!-----------------------------------------------------------------------
!
      RETURN
      END