42 INTEGER ,
INTENT(IN) :: IFIC
46 INTEGER N, M, NUM, NBL, ISTAT
47 DOUBLE PRECISION X1, X2, Y1, Y2, DX, DY
48 DOUBLE PRECISION U1, U2, V1, V2, DELS, MIDDIS
49 DOUBLE PRECISION,
DIMENSION (:),
ALLOCATABLE :: XL, YL, XP, YP
50 DOUBLE PRECISION,
DIMENSION (:),
ALLOCATABLE :: DS
52 CHARACTER(LEN=6) :: NOM, NOMX, NOMY, NOMDS
53 CHARACTER(LEN=1),
PARAMETER :: CHIFFRE(0:9) =
54 & (/
'0',
'1',
'2',
'3',
'4',
'5',
'6',
'7',
'8',
'9'/)
56 INTEGER,
ALLOCATABLE :: ITMP(:)
57 CHARACTER(LEN=1) :: COMMENT =
"#" 65 CALL skip_comment_line(ific, comment, ierr)
66 IF(ierr.NE.0)
GOTO 900
67 READ(ific,*,err=999)
nbrech 109 CALL skip_comment_line(ific, comment, ierr)
110 IF(ierr.NE.0)
GOTO 900
111 READ(ific,*,err=998)
polwdt%R(n)
112 CALL skip_comment_line(ific, comment, ierr)
113 IF(ierr.NE.0)
GOTO 900
114 READ(ific,*,err=997)
optnbr%I(n)
115 CALL skip_comment_line(ific, comment, ierr)
116 IF(ierr.NE.0)
GOTO 900
118 READ(ific,*,err=996)
tdecbr%R(n)
119 CALL skip_comment_line(ific, comment, ierr)
120 IF(ierr.NE.0)
GOTO 900
124 READ(ific,*,err=995)
durbr%R(n)
125 CALL skip_comment_line(ific, comment, ierr)
126 IF(ierr.NE.0)
GOTO 900
127 READ(ific,*,err=810)
optero%I(n)
128 CALL skip_comment_line(ific, comment, ierr)
129 IF(ierr.NE.0)
GOTO 900
130 READ(ific,*,err=994)
zfinbr%R(n)
131 CALL skip_comment_line(ific, comment, ierr)
132 IF(ierr.NE.0)
GOTO 900
134 READ(ific,*,err=993)
numpsd%I(n)
135 CALL skip_comment_line(ific, comment, ierr)
136 IF(ierr.NE.0)
GOTO 900
141 IF(num.EQ.
mesh%KNOLG%I(m))
THEN 148 READ(ific,*,err=992)
zdecbr%R(n)
149 CALL skip_comment_line(ific, comment, ierr)
150 IF(ierr.NE.0)
GOTO 900
153 READ(ific,*,err=991) nbl
154 CALL skip_comment_line(ific, comment, ierr)
155 IF(ierr.NE.0)
GOTO 900
159 ALLOCATE(xl(nbl), stat=istat)
160 CALL check_allocate(istat,
"XL")
161 ALLOCATE(yl(nbl), stat=istat)
162 CALL check_allocate(istat,
"YL")
163 ALLOCATE(ds(nbl-1), stat=istat)
164 CALL check_allocate(istat,
"DS")
167 READ(ific,*,err=990) xl(m), yl(m)
171 ALLOCATE(xp(2*nbl), stat=istat)
172 CALL check_allocate(istat,
"XP")
173 ALLOCATE(yp(2*nbl), stat=istat)
174 CALL check_allocate(istat,
"YP")
182 dels=sqrt(dx*dx+dy*dy)
183 IF(dels.GT.0.d0)
THEN 187 WRITE(
lu,*)
'PROBLEM IN DEFINITION OF BREACH :',n
192 xp(1) = x1 + v1*
polwdt%R(n)/2.d0
193 yp(1) = y1 + v2*
polwdt%R(n)/2.d0
194 xp(2*nbl) = x1 - v1*
polwdt%R(n)/2.d0
195 yp(2*nbl) = y1 - v2*
polwdt%R(n)/2.d0
202 ds(m-1)=sqrt(dx*dx+dy*dy)
203 IF(ds(m-1).GT.0.d0)
THEN 207 WRITE(
lu,*)
'PROBLEM IN DEFINITION OF BREACH :',n
212 xp(m) = x2 + v1*
polwdt%R(n)/2.d0
213 yp(m) = y2 + v2*
polwdt%R(n)/2.d0
214 xp(2*nbl-m+1) = x2 - v1*
polwdt%R(n)/2.d0
215 yp(2*nbl-m+1) = y2 - v2*
polwdt%R(n)/2.d0
228 IF(n.LE.
indbr%MAXBLOCK)
THEN 231 nom(4:4) = chiffre(n)
232 ELSEIF(n.LT.100)
THEN 233 nom(4:4) = chiffre(n/10)
234 nom(5:5) = chiffre(n-10*(n/10))
235 ELSEIF(n.LT.1000)
THEN 236 nom(4:4) = chiffre(n/100)
237 nom(5:5) = chiffre((n-100*(n/100))/10)
238 nom(6:6) = chiffre((n-100*(n/100))-10*((n-100*(n/100))/10))
240 WRITE(
lu,*)
'MORE THAN 999 BREACHS ASKED IN LECBREACH' 248 WRITE(
lu,*)
'LECBREACH:' 249 WRITE(
lu,*)
'MORE THAN ',
indbr%MAXBLOCK,
'(',n,
')' 250 WRITE(
lu,*)
'VECTORS TO BE ALLOCATED' 251 WRITE(
lu,*)
'CHANGE MAXBLOCK IN ALLBLO.' 257 indbr%ADR(n)%P%I(m) = itmp(m)
260 IF (
optero%I(n).EQ.2)
THEN 261 IF(n.LE.
dkaxcr%MAXBLOCK)
THEN 266 nomx(4:4) = chiffre(n)
267 nomy(4:4) = chiffre(n)
268 nomds(4:4) = chiffre(n)
269 ELSEIF(n.LT.100)
THEN 270 nomx(4:4) = chiffre(n/10)
271 nomx(5:5) = chiffre(n-10*(n/10))
272 nomy(4:4) = chiffre(n/10)
273 nomy(5:5) = chiffre(n-10*(n/10))
274 nomds(4:4) = chiffre(n/10)
275 nomds(5:5) = chiffre(n-10*(n/10))
276 ELSEIF(n.LT.1000)
THEN 277 nomx(4:4) = chiffre(n/100)
278 nomx(5:5) = chiffre((n-100*(n/100))/10)
280 & chiffre((n-100*(n/100))-10*((n-100*(n/100))/10))
281 nomy(4:4) = chiffre(n/100)
282 nomy(5:5) = chiffre((n-100*(n/100))/10)
284 & chiffre((n-100*(n/100))-10*((n-100*(n/100))/10))
285 nomds(4:4) = chiffre(n/100)
286 nomds(5:5) = chiffre((n-100*(n/100))/10)
288 & chiffre((n-100*(n/100))-10*((n-100*(n/100))/10))
290 WRITE(
lu,*)
'MORE THAN 999 BREACHS ASKED IN LECBREACH' 304 WRITE(
lu,*)
'LECBREACH:' 305 WRITE(
lu,*)
'MORE THAN ',
dkaxcr%MAXBLOCK,
'(',n,
')' 306 WRITE(
lu,*)
'VECTORS TO BE ALLOCATED' 307 WRITE(
lu,*)
'CHANGE MAXBLOCK IN ALLBLO.' 313 dkaxcr%ADR(n)%P%R(m)=xl(m)
314 dkaycr%ADR(n)%P%R(m)=yl(m)
316 pondsb%ADR(n)%P%R(m-1)=ds(m-1)
324 findmidnode:
DO m=2,nbl
325 middis=middis+ds(m-1)
326 IF (middis .GE. (
finbrw%R(n)/2.d0))
THEN 331 WRITE(
lu,*)
'INCREASE NUMBER OF POINTS OF BREACH :',n
360 WRITE(
lu,*)
'LECBREACH : READ ERROR ON THE' 361 WRITE(
lu,*)
' BREACHES DATA FILE' 362 WRITE(
lu,*)
' FOR THE BREACH ',n
363 WRITE(
lu,*)
' EROSION OPTION CANNOT BE READ' 367 WRITE(
lu,*)
'LECBREACH: UNAVAILABLE EROSION OPTION' 371 WRITE(
lu,*)
'LECBREACH: READ ERROR ON THE BREACHES DATA FILE' 372 WRITE(
lu,*)
' AT LINE 2' 376 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 377 WRITE(
lu,*)
' BREACHES DATA FILE' 378 WRITE(
lu,*)
' FOR THE BREACH ',n
379 WRITE(
lu,*)
' BREACH POLYGON WIDTH CANNOT BE READ' 383 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 384 WRITE(
lu,*)
' BREACHES DATA FILE' 385 WRITE(
lu,*)
' FOR THE BREACH ',n
386 WRITE(
lu,*)
' OPTION CANNOT BE READ' 390 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 391 WRITE(
lu,*)
' BREACHES DATA FILE' 392 WRITE(
lu,*)
' FOR THE BREACH ',n
393 WRITE(
lu,*)
' THE STARTING TIME CANNOT BE READ' 397 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 398 WRITE(
lu,*)
' BREACHES DATA FILE' 399 WRITE(
lu,*)
' FOR THE BREACH ',n
400 WRITE(
lu,*)
' THE OPENNING DURATION CANNOT BE READ' 404 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 405 WRITE(
lu,*)
' BREACHES DATA FILE' 406 WRITE(
lu,*)
' FOR THE BREACH ',n
407 WRITE(
lu,*)
' THE FINAL LEVEL CANNOT BE READ' 411 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 412 WRITE(
lu,*)
' BREACHES DATA FILE' 413 WRITE(
lu,*)
' FOR THE BREACH ',n
414 WRITE(
lu,*)
' THE NUMBER OF TEST POINT CANNOT BE READ' 418 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 419 WRITE(
lu,*)
' BREACHES DATA FILE' 420 WRITE(
lu,*)
' FOR THE BREACH ',n
421 WRITE(
lu,*)
' THE STARTING LEVEL CANNOT BE READ' 425 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 426 WRITE(
lu,*)
' BREACHES DATA FILE' 427 WRITE(
lu,*)
' FOR THE BREACH ',n
428 WRITE(
lu,*)
' THE POINT NUMBER OF LINE CANNOT BE READ' 432 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 433 WRITE(
lu,*)
' BREACHES DATA FILE' 434 WRITE(
lu,*)
' FOR THE BREACH ',n
435 WRITE(
lu,*)
' THE COORDINATE OF POINT ',m
436 WRITE(
lu,*)
' CANNOT BE READ' 440 WRITE(
lu,*)
'BRECHE : READ ERROR ON THE' 441 WRITE(
lu,*)
' BREACHES DATA FILE' 442 WRITE(
lu,*)
' UNEXPECTED END OF FILE'
subroutine allblo(BLO, NOM)
type(bief_obj), target dkaxcr
subroutine bief_allvec(NAT, VEC, NOM, IELM, DIM2, STATUT, MESH)
type(bief_obj), target zfinbr
type(bief_obj), target finbrw
type(bief_obj), target pondsb
logical function inpoly(X, Y, XSOM, YSOM, NSOM)
type(bief_obj), target polwdt
type(bief_obj), target nponbr
type(bief_obj), target zdecbr
type(bief_obj), target durbr
type(bief_obj), target optnbr
type(bief_obj), target inibrw
type(bief_mesh), target mesh
type(bief_obj), target optero
subroutine lecbreach(IFIC)
type(bief_obj), target dkaycr
type(bief_obj), target curbrw
subroutine first_all_biefobj(OBJ)
type(bief_obj), target zcrbr
type(bief_obj), target nbndbr
type(bief_obj), target tdecbr
type(bief_obj), target indbr
type(bief_obj), target numpsd