The TELEMAC-MASCARET system  trunk
fill_lim.f
Go to the documentation of this file.
1 ! *******************
2  SUBROUTINE fill_lim
3 ! *******************
4 !
5  & (nptfr,nptfrx,ntrac,lihbor,liubor,livbor,litbor,
6  & hbor,ubor,vbor,chbord,tbor,atbor,btbor, nbor, old_nbor)
7 !
8 !***********************************************************************
9 ! PROGICIEL : STBTEL V5.2 J-M JANIN (LNH) 30 87 72 84
10 ! ORIGINE : TELEMAC
11 !***********************************************************************
12 !
13 ! FUNCTION : FILLS THE BOUNDARY CONDITIONS ARRAYS BASED ON THE
14 ! COARSER MESH INFORMATION
15 !
16 !-----------------------------------------------------------------------
17 ! ARGUMENTS
18 ! .________________.____.______________________________________________
19 ! | NOM |MODE| ROLE
20 ! |________________|____|______________________________________________
21 ! | HBOR | <->| PRESCRIBED DEPTH
22 ! | LIHBOR | -->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
23 ! | LITBOR | -->| TYPE OF BOUNDARY CONDITIONS ON TRACERS
24 ! | LIUBOR | -->| TYPE OF BOUNDARY CONDITIONS ON VELOCITY
25 ! |________________|____|______________________________________________
26 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
27 !----------------------------------------------------------------------
28 ! APPELE PAR : STBTEL
29 !***********************************************************************
30 !
31  USE bief
33  IMPLICIT NONE
34 
35  INTEGER, INTENT(IN) :: NPTFR,NPTFRX,NTRAC
36  INTEGER,INTENT(INOUT) :: LIHBOR(nptfrx),LIUBOR(nptfrx)
37  INTEGER,INTENT(INOUT) :: LIVBOR(nptfrx)
38  TYPE(bief_obj) , INTENT(INOUT) :: LITBOR
39  DOUBLE PRECISION, INTENT(INOUT) :: UBOR(nptfrx,2),VBOR(nptfrx,2)
40  DOUBLE PRECISION, INTENT(INOUT) :: HBOR(nptfrx)
41  DOUBLE PRECISION, INTENT(INOUT) :: CHBORD(nptfrx)
42  TYPE(bief_obj) , INTENT(INOUT) :: TBOR, ATBOR, BTBOR
43  INTEGER, INTENT(IN) :: NBOR(nptfrx), OLD_NBOR(nptfrx)
44 
45  INTEGER I, P1, P2
46  INTEGER VAL_P1, VAL_P2, IDX
47 
48  LOGICAL :: REORDER, FOUND
49  INTEGER, ALLOCATABLE :: CONV(:)
50  INTEGER J, NODE
51 
52  ! Check if the nbor of the original mesh has the same oredering as
53  ! the one in the refine mesh that went through ranbo
54  reorder = .false.
55  DO i=1,nptfr
56  IF (old_nbor(i) .NE. nbor(2*i-1)) THEN
57  reorder = .true.
58  EXIT
59  ENDIF
60  ENDDO
61 
62  ALLOCATE(conv(nptfr))
63 
64  IF (reorder) THEN
65  DO i=1,nptfr
66  node = nbor(2*i-1)
67  found = .false.
68  DO j=1,nptfr
69  IF (old_nbor(j).EQ.node) THEN
70  found = .true.
71  EXIT
72  ENDIF
73  ENDDO
74  conv(i) = j
75  ENDDO
76  ELSE
77  DO i=1,nptfr
78  conv(i) = i
79  ENDDO
80  ENDIF
81 !
82 
83  ! Setting all odd value to the not refined value (this is valid
84  ! because fo the reodering and the fact that each boundary segment
85  ! is split in two)
86  ! Using usb array ensure that we first read all the values and
87  ! then copy them
88 
89  lihbor(1:nptfr*2:2)=lihbor(conv)
90  liubor(1:nptfr*2:2)=liubor(conv)
91  livbor(1:nptfr*2:2)=livbor(conv)
92 
93  chbord(1:nptfr*2:2)=chbord(conv)
94  hbor(1:nptfr*2:2)=hbor(conv)
95  ubor(1:nptfr*2:2,1)=ubor(conv,1)
96  vbor(1:nptfr*2:2,1)=vbor(conv,1)
97  ubor(1:nptfr*2:2,2)=ubor(conv,2)
98  vbor(1:nptfr*2:2,2)=vbor(conv,2)
99 
100  IF (ntrac.GT.0) THEN
101  litbor%ADR(1)%P%I(1:nptfr*2:2)=litbor%ADR(1)%P%I(conv)
102  atbor%ADR(1)%P%R(1:nptfr*2:2)=atbor%ADR(1)%P%R(conv)
103  btbor%ADR(1)%P%R(1:nptfr*2:2)=btbor%ADR(1)%P%R(conv)
104  ENDIF
105 
106  DEALLOCATE(conv)
107 !
108  ! Filling the point in the middle of each segment
109  DO i=1,nptfr
110 
111  p1 = 2*i-1
112  p2 = 2*i+1
113  IF(i.EQ.nptfr) THEN
114  p2 = 1
115  ENDIF
116 !
117  val_p1 = lihbor(p1)*1000 +
118  & liubor(p1)*100 +
119  & livbor(p1)*10
120  IF(ntrac.GT.0) THEN
121  val_p1 = val_p1 + litbor%ADR(1)%P%I(p1)*1
122  ENDIF
123 
124  val_p2 = lihbor(p2)*1000 +
125  & liubor(p2)*100 +
126  & livbor(p2)*10
127  IF(ntrac.GT.0) THEN
128  val_p2 = val_p2 + litbor%ADR(1)%P%I(p2)*1
129  ENDIF
130 
131  ! If same type on each point apply the same type
132  IF (val_p1.EQ.val_p2) THEN
133  idx = p1
134  ! If one of the points is a solid point taking that one
135  ELSE IF(lihbor(p1).EQ.2) THEN
136  idx = p1
137  ELSEIF(lihbor(p2).EQ.2) THEN
138  idx = p2
139  ! Otherwise taking the smallest one
140  ELSEIF(val_p1.LT.val_p2) THEN
141  idx = p1
142  ELSE
143  idx = p2
144  ENDIF
145 
146  lihbor(2*i)=lihbor(idx)
147  liubor(2*i)=liubor(idx)
148  livbor(2*i)=livbor(idx)
149  chbord(2*i)=chbord(idx)
150  hbor(2*i)=hbor(idx)
151  ubor(2*i,1)=ubor(idx,1)
152  vbor(2*i,1)=vbor(idx,1)
153  ubor(2*i,2)=ubor(idx,2)
154  vbor(2*i,2)=vbor(idx,2)
155 !
156  IF(ntrac.GT.0) THEN
157  litbor%ADR(1)%P%I(2*i)=litbor%ADR(1)%P%I(idx)
158  atbor%ADR(1)%P%R(2*i)=atbor%ADR(1)%P%R(idx)
159  btbor%ADR(1)%P%R(2*i)=btbor%ADR(1)%P%R(idx)
160  ENDIF
161 !
162  ENDDO
163 !
164  END SUBROUTINE
subroutine fill_lim(NPTFR, NPTFRX, NTRAC, LIHBOR, LIUBOR, LIVBOR, LITBOR, HBOR, UBOR, VBOR, CHBORD, TBOR, ATBOR, BTBOR, NBOR, OLD_NBOR)
Definition: fill_lim.f:8
Definition: bief.f:3