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