Commit e461acc6 authored by Anthony's avatar Anthony
Browse files

Linkup : correction to avoid infinite loop if if linkup not valid

parent 8fd7073c
......@@ -2257,6 +2257,8 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
solved(sp,2) = solved(sp,2) + 1
found = 1
WRITE (numout,*) "Neighbours, output found at:" , nb, "level"
ELSE
nb = nb+1
ENDIF
!
ELSE
......@@ -2339,7 +2341,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
dop = minhloc(basin_id(sp,sb),1)
bop = minhloc(basin_id(sp,sb),2)
IF ((dop < undef_int ) .AND. (dop .GT. 0) .AND. (bop < undef_int) .AND. (bop .GT. 0)) THEN
CALL routing_updateflow(sp, sb, dop, bop, nbpt,nwbas, inflowmax, outflow_grid, outflow_basin, &
& inflow_number, inflow_grid, inflow_basin)
! It is possible that the lowest hierarchy is in two grid cells
......
......@@ -618,16 +618,20 @@ CONTAINS
!
transfer = .TRUE.
DO i=1,in_number(sp,sb)
IF (in_grid(sp,sb,i) == ep .AND. in_basin(sp,sb,i) == eb ) THEN
WRITE(numout,*) "We have a problem here !", ep, eb, " already flows into ", sp, sb
transfer = .FALSE.
ENDIF
IF ( transfer ) THEN
IF (in_grid(sp,sb,i) == ep .AND. in_basin(sp,sb,i) == eb ) THEN
WRITE(numout,*) "We have a problem here !", ep, eb, " already flows into ", sp, sb
transfer = .FALSE.
ENDIF
END IF
ENDDO
!
! Just in case this was not caught in the calling program.
!
IF ( ep <= 0 .OR. ep == undef_int .OR. eb <= 0 .OR. eb == undef_int) THEN
transfer = .FALSE.
IF ( transfer ) THEN
IF ( ep <= 0 .OR. ep == undef_int .OR. eb <= 0 .OR. eb == undef_int) THEN
transfer = .FALSE.
ENDIF
ENDIF
!
IF ( transfer ) THEN
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment