Skip to content

GitLab

Commit a8b12804 authored by POLCHER Jan's avatar POLCHER Jan 🚴🏾
Browse files

Some clean-up in thte output written so that the text files are not as big.

parent c0fe4d86
Show whitespace changes
Inline Side-by-side
Showing with 31 additions and 45 deletions
F90subroutines/routing_interface.f90
View file @ a8b12804
......@@ -90,14 +90,14 @@ SUBROUTINE gethydrogrid(nbpt, nbvmax_in, ijdimmax, sub_pts, sub_index, sub_area,
!
INTEGER :: ii, ib
REAL :: resolution(nbpt,2)
LOGICAL :: debug = .FALSE.
!
! nbvmax is still used to dimension wome variables in routing_reg.f90.
! It is transfered here but should be argument to the various subroutines.
!
nbvmax = nbvmax_in
!
WRITE(numout,*) "Memory Mgt getgrid : nbvmax, ijdimmax = ", nbvmax, ijdimmax
IF ( debug ) WRITE(numout,*) "Memory Mgt getgrid : nbvmax, ijdimmax = ", nbvmax, ijdimmax
!
DO ii=1,nbpt
resolution(ii,1) = SQRT(area(ii))
......@@ -157,10 +157,11 @@ SUBROUTINE findbasins(nbpt, nb_htu, nbv, ijdimmax, nbi, nbj, trip_bx, basin_bx,
! Local
!
INTEGER :: ib
LOGICAL :: debug = .FALSE.
!
!diaglalo(1,:) = (/ 39.6791, 2.6687 /)
!
WRITE(numout,*) "Memory Mgt findbasin : nbvmax, nb_htu, nbv = ", nbvmax, nb_htu, nbv
IF ( debug) WRITE(numout,*) "Memory Mgt findbasin : nbvmax, nb_htu, nbv = ", nbvmax, nb_htu, nbv
DO ib=1,nbpt
CALL routing_reg_findbasins(nb_htu, nbv, ib, nbi(ib), nbj(ib), trip_bx(ib,:,:), &
......@@ -232,8 +233,6 @@ SUBROUTINE globalize(nbpt, nb_htu, nbv, ijdimmax, area_bx, lon_bx, lat_bx, trip_
!!
INTEGER(i_std) :: ib
!!
WRITE(numout,*) "Memory Mgt globalize : nbvmax, ijdimmax, nbv, nwbas, nb_htu = ", nbvmax, ijdimmax, nbv, nwbas, nb_htu
!!
DO ib=1,nbpt
CALL routing_reg_globalize(nbpt, nb_htu, nbv, ib, ijdimmax, neighbours, area_bx(ib,:,:),&
& lon_bx(ib,:,:), lat_bx(ib,:,:), trip_bx(ib,:,:), &
......@@ -282,8 +281,9 @@ SUBROUTINE linkup(nbpt, ijdimmax, nwbas, inflowmax, basin_count, basin_area, bas
INTEGER(i_std), INTENT(inout), DIMENSION(nbpt,nwbas) :: coastal_basin !!
!
!
WRITE(numout,*) "Memory Mgt Linkup : nbvmax, ijdimmax, nwbas, inflowmax = ", nbvmax, ijdimmax, nwbas, inflowmax
LOGICAL :: debug = .FALSE.
!
IF ( debug ) WRITE(numout,*) "Memory Mgt Linkup : nbvmax, ijdimmax, nwbas, inflowmax = ", nbvmax, ijdimmax, nwbas, inflowmax
CALL routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basin_count, basin_area, basin_id, basin_flowdir, &
& basin_lshead, basin_hierarchy, basin_fac, diaglalo, outflow_grid, outflow_basin, inflow_number, inflow_grid, &
......@@ -606,15 +606,19 @@ SUBROUTINE killbas(nbpt, inflowmax, nbasmax, nwbas, ops, tokill, totakeover, num
!! LOCAL
INTEGER(i_std) :: ib, op, tok, totak, igrif, ibasf
LOGICAL :: debug = .FALSE.
!
!
!
DO ib=1,nbpt
DO op=1,numops(ib)
IF (basin_count(ib) > nbasmax) THEN
tok = tokill(ib,op)
totak = totakeover(ib,op)
IF (tok .GT. 0) THEN
IF ( debug ) THEN
WRITE(numout,*) "nbpt", ib, "tokill", tok, "totakover", totak
ENDIF
! Test if tokill is downstream of totakeover (avoid loop)
igrif = outflow_grid(ib,totak)
ibasf = outflow_basin(ib,totak)
......@@ -661,11 +665,11 @@ SUBROUTINE checkrouting(nbpt, nwbas, outflow_grid, outflow_basin, basin_count)
! Local
INTEGER(i_std), DIMENSION(nbpt,nwbas) :: flag !!
INTEGER(i_std) :: ig, ib, it, igrif, ibasf, basnum, test
LOGICAL :: debug = .FALSE.
!
flag(:,:) = 0
WRITE(numout,*) "Checking routing"
!
IF ( debug ) WRITE(numout,*) "Checking routing"
test = 0
DO ig=1,nbpt
......@@ -713,7 +717,7 @@ SUBROUTINE checkrouting(nbpt, nwbas, outflow_grid, outflow_basin, basin_count)
END DO
END DO
WRITE(numout,*) "**** Fetch has",test, "loop errors"
IF ( debug ) WRITE(numout,*) "**** Fetch has",test, "loop errors"
END SUBROUTINE checkrouting
......@@ -776,13 +780,14 @@ SUBROUTINE correct_inflows(nbpt, nwbas, inflowmax, outflow_grid,&
! LOCAL
INTEGER(i_std) :: ig, nbas, ib, og, ob
WRITE(numout,*) "Checking if the HTUs are in the inflows of their outflow"
LOGICAL :: debug = .FALSE.
!
IF ( debug ) WRITE(numout,*) "Checking if the HTUs are in the inflows of their outflow"
!
inflow_number(:,:) = 0
inflow_basin(:,:,:)=0
inflow_grid(:,:,:)=0
!
DO ig=1,nbpt
nbas = basin_count(ig)
DO ib=1,nbas
......@@ -817,8 +822,9 @@ SUBROUTINE checkfetch(nbpt, nwbas, fetch_basin, outflow_grid, outflow_basin, bas
INTEGER(i_std), DIMENSION(nbpt), INTENT(in) :: basin_count !!
! Local
INTEGER(i_std) :: ig, ib, it, bt, igrif, ibasf, basnum, test
WRITE(numout,*) "Checking Fetch coherence"
LOGICAL :: debug = .FALSE.
!
IF ( debug ) WRITE(numout,*) "Checking Fetch coherence"
test = 0
DO ig=1,nbpt
......
F90subroutines/routing_reg.f90
View file @ a8b12804
......@@ -403,7 +403,7 @@ CONTAINS
INTEGER(i_std), INTENT(out) :: coast_pts(nb_htu) !! The coastal flow points (unitless)
!
!! LOCAL VARIABLES
LOGICAL, PARAMETER :: debug=.TRUE.
LOGICAL, PARAMETER :: debug=.FALSE.
CHARACTER(LEN=7) :: fmt !!
CHARACTER(LEN=9) :: fmtr !!
!
......@@ -1720,14 +1720,7 @@ SUBROUTINE routing_reg_globalize(nbpt, nb_htu, nbv, ib, ijdimmax, neighbours, ar
!
! Get option for calculating topoindex
!
!Config Key = TOPOINDEX
!Config Desc = Options to calculate topoindex
!Config Def = 3
!Config Help = This flag allows to calculate topoindex with different options
!Config Units = [-]
!
option = 3
!!$ CALL getin('TOPOINDEX', option)
!
! Checking option: until now (May 2016) there is only 3 acceptable options
! = 1 : topoindex .EQ. 1000. everywhere
......@@ -1891,6 +1884,7 @@ SUBROUTINE routing_reg_globalize(nbpt, nb_htu, nbv, ib, ijdimmax, neighbours, ar
ENDDO
ENDIF
ENDIF
!
ENDIF
!
! To make sure that it has the lowest number if this is an outflow point we reset basin_hierarchy
......@@ -2022,7 +2016,7 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
!
!! PARAMETERS
LOGICAL, PARAMETER :: debug = .TRUE. !! (true/false)
LOGICAL, PARAMETER :: debug = .FALSE. !! (true/false)
!
!_ ================================================================================================================================
!
......@@ -2076,7 +2070,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
found = 0
IF ( outflow_grid(sp,sb) == 0 ) THEN
found = 1
WRITE(numout,*) sp, sb, "Linkup 1.0 -- Flow out of Halo zone"
ELSE
found = 0
END IF
......@@ -2088,7 +2081,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
CALL routing_updateflow(sp, sb, sp, bop, nbpt, nwbas, inflowmax, outflow_grid, outflow_basin, &
& inflow_number, inflow_grid, inflow_basin)
IF ( outflow_basin(sp,sb) == bop ) THEN
WRITE(numout,*) sp, sb, "flows in the same grid !"
found = 1
solved(sp,1) = solved(sp,1) + 1
ELSE
......@@ -2100,19 +2092,16 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
! Nothing to do but just remember it is done.
found = 1
solved(sp,1) = solved(sp,1) + 1
WRITE(numout,*) sp,sb,"is a return flow"
ELSE IF ( outflow_grid(sp,sb) .EQ. -2 ) THEN
! Coastal flow
! Nothing to do but just remember it is done.
found = 1
solved(sp,1) = solved(sp,1) + 1
WRITE(numout,*) sp,sb,"is a coastal flow"
ELSE IF ( outflow_grid(sp,sb) .EQ. -1 ) THEN
! River flow
! Nothing to do but just remember it is done.
found = 1
solved(sp,1) = solved(sp,1) + 1
WRITE(numout,*) sp,sb,"is a river outflow"
ENDIF
END IF
IF ( found .EQ. 0 ) THEN
......@@ -2133,13 +2122,11 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
IF ( outflow_basin(sp,sb) == bop ) THEN
solved(sp,1) = solved(sp,1) + 1
found = 1
WRITE(numout,*) sp, sb, "Solution found in the original outflow_grid", sb, bop
ENDIF
!
ENDIF
!
IF ( found == 0 ) THEN
WRITE (numout,*) "Establishing the list of neighbours"
! Organize the location of the neighbours to visit by order of priority
! first the outflow grid then 2 by 2 till the opposite side (by +1/-1 - +2/-2 ...)
! if NbNeighb is odd we have to had the opposite neighbour
......@@ -2252,7 +2239,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
IF ( outflow_basin(sp,sb) == bop ) THEN
solved(sp,2) = solved(sp,2) + 1
found = 1
WRITE (numout,*) sp, sb,"->Sol. in neighbours, output found at level:",nb,"dop,bop=",dop,bop
ELSE
nb = nb+1
ENDIF
......@@ -2272,7 +2258,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
! Looking for a solution in the grid -> HTU with a similar hierarchy or lowest hierarchy
!
IF ( found == 0 ) THEN
WRITE (numout,*) "Looking for a solution in the grid"
sbint = undef_int
DO sba=1,basin_count(sp)
IF ( sba .NE. sb ) THEN
......@@ -2322,7 +2307,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
& inflow_number, inflow_grid,inflow_basin)
IF (outflow_basin(sp,sb) == sbint) THEN
found = 1
WRITE (numout,*) sp, sb, "Lowest basin hierarchy in the grid file"
END IF
ENDIF
ENDIF
......@@ -2345,13 +2329,9 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
! We go to next step and make it a coastal flow
IF (outflow_basin(sp, sb) .EQ. bop) THEN
found = 1
WRITE(numout,*) sp, sb, "Lowest basin hierarchy in the neighbours grid points"
ELSE
WRITE(numout,*) sp, sb, "Lowest hierarchy may be in two different grid points"
END IF
WRITE(numout,*) "sp,sb = ", sp,sb, " dop,bop = ", dop,bop
WRITE(numout,*) "hierarch of (sp,sb)", basin_hierarchy(sp,sb)
WRITE(numout,*) "Lowest basinid hierarch", basin_hierarchy(dop,bop)
END IF
END IF
END DO
......@@ -2384,7 +2364,6 @@ SUBROUTINE routing_reg_linkup(nbpt, neighbours, nwbas, ijdimmax, inflowmax, basi
! But I need the model works now !!! => so, come back
! here later !
!
WRITE (numout,*) "Linkup : Made a NEW OUTLET at sp & sb: ",sp,sb
! Coastal flow or river flow is both ok here
outflow_grid(sp,sb) = -2
basin_hierarchy(sp,sb) = 0.00
......@@ -2784,6 +2763,7 @@ SUBROUTINE routing_reg_end_truncate(nbpt, nbasmax, gridarea, contfrac, gridcente
route_togrid_glo(ib,ij) = outflow_grid(ib,ij)
route_tobasin_glo(ib,ij) = outflow_basin(ib,ij)
!
!
ENDDO
ENDDO
!
......
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