-
Lionel GUEZ authored
`settings.mk` in GNUmakefile. Bug fix in procedure `dispatch_snapshot`: an isolated eddy is a valid eddy. In script `plot_snapshot.py`, in function snaphot, replace argument ax with argument `new_figure` so the user does not have to call figure and `axes(projection = projection)`. Add argument light to function snapshot so we can call snapshot with light set to False for a second snapshot. Add a test to only read `h.nc` when we need it. In script `read_overlap.py`, print more information: number of nodes, number of edges, number of nodes with at least one successor, number of nodes with at least one predecessor, splitting events, merging events. In script `stat.py`, use the convention that shapefiles are grouped in a directory instead of identifying a set of shapefiles by the end of their basename. In main program `test_successive_overlap`, we know that `delta_in` for snapshot 1 and `delta_out` for snapshot 2 are `huge(0)` so do not test this. Print eddy identifiers in a single line. Add the printing of identifiers of isolated eddies.
Lionel GUEZ authored`settings.mk` in GNUmakefile. Bug fix in procedure `dispatch_snapshot`: an isolated eddy is a valid eddy. In script `plot_snapshot.py`, in function snaphot, replace argument ax with argument `new_figure` so the user does not have to call figure and `axes(projection = projection)`. Add argument light to function snapshot so we can call snapshot with light set to False for a second snapshot. Add a test to only read `h.nc` when we need it. In script `read_overlap.py`, print more information: number of nodes, number of edges, number of nodes with at least one successor, number of nodes with at least one predecessor, splitting events, merging events. In script `stat.py`, use the convention that shapefiles are grouped in a directory instead of identifying a set of shapefiles by the end of their basename. In main program `test_successive_overlap`, we know that `delta_in` for snapshot 1 and `delta_out` for snapshot 2 are `huge(0)` so do not test this. Print eddy identifiers in a single line. Add the printing of identifiers of isolated eddies.
dispatch_snapshot.f90 1.17 KiB
module dispatch_snapshot_m
implicit none
contains
subroutine dispatch_snapshot(s, unit_isolated, unit_number_eddies, k, m, &
k_begin, max_delta)
use derived_types, only: snapshot
use send_snapshot_m, only: send_snapshot
type(snapshot), intent(in):: s
integer, intent(in):: unit_isolated
! logical unit for file isolated_nodes_$m.csv
integer, intent(in):: unit_number_eddies
! logical unit for file number_eddies_$m.csv
integer, intent(in):: k ! date index
integer, intent(in):: m, k_begin, max_delta
! Local:
integer i
!------------------------------------------------------------------
if (m == 1 .or. k >= k_begin + max_delta) then
do i = 1, s%number_vis_extr
if (s%list_vis(i)%valid .and. s%list_vis(i)%delta_in == huge(0) &
.and. s%list_vis(i)%delta_out == huge(0)) &
write(unit_isolated, fmt = *) k, i
end do
write(unit_number_eddies, fmt = *) k, s%number_vis_extr, &
s%number_eddies - s%number_vis_extr
else
call send_snapshot(s, tag = k, dest = m - 1)
end if
end subroutine dispatch_snapshot
end module dispatch_snapshot_m