Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix issue #1 the apparent hang in writing the trajectories #3

Merged
merged 2 commits into from
Jul 17, 2015
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
38 changes: 35 additions & 3 deletions icebergs_framework.F90
Original file line number Diff line number Diff line change
Expand Up @@ -39,12 +39,14 @@ module ice_bergs_framework
real, parameter :: pi_180=pi/180. ! Converts degrees to radians
logical :: fix_restart_dates=.true. ! After a restart, check that bergs were created before the current model date
logical :: do_unit_tests=.false. ! Conduct some unit tests
logical :: force_all_pes_traj=.false. ! Force all pes write trajectory files regardless of io_layout
logical :: reverse_traj=.false. ! Force trajectories to be written in reverse order into files to save time

!Public params !Niki: write a subroutine to expose these
public nclasses,buffer_width,buffer_width_traj
public verbose, really_debug, debug, restart_input_dir,make_calving_reproduce,old_bug_bilin,use_roundoff_fix
public ignore_ij_restart, use_slow_find,generate_test_icebergs,old_bug_rotated_weights,budget
public orig_read
public orig_read, force_all_pes_traj, reverse_traj


!Public types
Expand All @@ -65,6 +67,7 @@ module ice_bergs_framework
public checksum_gridded
public grd_chksum2,grd_chksum3
public fix_restart_dates, offset_berg_dates
public reverse_list

type :: icebergs_gridded
type(domain2D), pointer :: domain ! MPP domain
Expand Down Expand Up @@ -164,6 +167,7 @@ module ice_bergs_framework
integer :: traj_sample_hrs
integer :: verbose_hrs
integer :: clock, clock_mom, clock_the, clock_int, clock_cal, clock_com, clock_ini, clock_ior, clock_iow, clock_dia ! ids for fms timers
integer :: clock_trw, clock_trp
real :: rho_bergs ! Density of icebergs [kg/m^3]
real :: LoW_ratio ! Initial ratio L/W for newly calved icebergs
real :: bergy_bit_erosion_fraction ! Fraction of erosion melt flux to divert to bergy bits
Expand Down Expand Up @@ -274,7 +278,8 @@ subroutine ice_bergs_framework_init(bergs, &
rho_bergs, LoW_ratio, debug, really_debug, use_operator_splitting, bergy_bit_erosion_fraction, &
parallel_reprod, use_slow_find, sicn_shift, add_weight_to_ocean, passive_mode, ignore_ij_restart, &
time_average_weight, generate_test_icebergs, speed_limit, fix_restart_dates, use_roundoff_fix, &
old_bug_rotated_weights, make_calving_reproduce,restart_input_dir, orig_read, old_bug_bilin,do_unit_tests,grounding_fraction
old_bug_rotated_weights, make_calving_reproduce,restart_input_dir, orig_read, old_bug_bilin,do_unit_tests,grounding_fraction,&
force_all_pes_traj, reverse_traj

! Local variables
integer :: ierr, iunit, i, j, id_class, axes3d(3), is,ie,js,je,np
Expand Down Expand Up @@ -323,6 +328,7 @@ subroutine ice_bergs_framework_init(bergs, &
bergs%clock_ior=mpp_clock_id( 'Icebergs-I/O read', flags=clock_flag_default, grain=CLOCK_SUBCOMPONENT )
bergs%clock_iow=mpp_clock_id( 'Icebergs-I/O write', flags=clock_flag_default, grain=CLOCK_SUBCOMPONENT )
bergs%clock_dia=mpp_clock_id( 'Icebergs-diagnostics', flags=clock_flag_default, grain=CLOCK_SUBCOMPONENT )

call mpp_clock_begin(bergs%clock)
call mpp_clock_begin(bergs%clock_ini)

Expand Down Expand Up @@ -1201,7 +1207,9 @@ subroutine unpack_traj_from_buffer2(first, buff, n)
traj%cn=buff%data(22,n)
traj%hi=buff%data(23,n)

call append_posn(first, traj)
! call append_posn(first, traj) !This call could take a very long time (as if the run hangs) if there are millions of nodes in the list. Use push_posn instead and reverse the list later before writing the file.
!
call push_posn(first, traj)

end subroutine unpack_traj_from_buffer2

Expand Down Expand Up @@ -1623,6 +1631,30 @@ end subroutine record_posn

! ##############################################################################

subroutine reverse_list(list)
! Arguments
type(xyt), pointer :: list

! Local variables
type(xyt), pointer :: head,tail,node
integer :: i

i=0
head=>list
tail=>list
node=>list%next
list%next=>null()
do while (associated(node))
head=>node
node=>node%next
head%next=>tail
tail=>head
i=i+1
enddo
list=>head
print*,'reverse_list number of nodes= ',i
end subroutine reverse_list

subroutine push_posn(trajectory, posn_vals)
! Arguments
type(xyt), pointer :: trajectory
Expand Down
36 changes: 31 additions & 5 deletions icebergs_io.F90
Original file line number Diff line number Diff line change
Expand Up @@ -16,20 +16,25 @@ module ice_bergs_io
use fms_io_mod, only : register_restart_axis, register_restart_field, set_domain, nullify_domain
use fms_io_mod, only : read_unlimited_axis =>read_compressed, field_exist, get_field_size

use mpp_mod, only : mpp_clock_begin, mpp_clock_end, mpp_clock_id
use mpp_mod, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT, CLOCK_LOOP
use fms_mod, only : clock_flag_default

use time_manager_mod, only: time_type, get_date, get_time, set_date, operator(-)

use ice_bergs_framework, only: icebergs_gridded, xyt, iceberg, icebergs, buffer
use ice_bergs_framework, only: pack_berg_into_buffer2,unpack_berg_from_buffer2
use ice_bergs_framework, only: pack_traj_into_buffer2,unpack_traj_from_buffer2
use ice_bergs_framework, only: find_cell,find_cell_by_search,count_bergs,is_point_in_cell,pos_within_cell,append_posn
use ice_bergs_framework, only: push_posn
use ice_bergs_framework, only: add_new_berg_to_list,destroy_iceberg
use ice_bergs_framework, only: increase_ibuffer,increase_ibuffer_traj,grd_chksum2,grd_chksum3
use ice_bergs_framework, only: sum_mass,sum_heat,bilin
!params !Niki: write a subroutine to get these
use ice_bergs_framework, only: nclasses, buffer_width, buffer_width_traj
use ice_bergs_framework, only: verbose, really_debug, debug, restart_input_dir,make_calving_reproduce
use ice_bergs_framework, only: ignore_ij_restart, use_slow_find,generate_test_icebergs,print_berg

use ice_bergs_framework, only: reverse_list, force_all_pes_traj, reverse_traj

implicit none ; private

Expand All @@ -48,6 +53,8 @@ module ice_bergs_io
integer, allocatable,save :: io_tile_pelist(:)
logical :: is_io_tile_root_pe = .true.

integer :: clock_trw,clock_trp

#ifdef _FILE_VERSION
character(len=128) :: version = _FILE_VERSION
#else
Expand Down Expand Up @@ -81,6 +88,9 @@ subroutine ice_bergs_io_init(bergs, io_layout)
io_npes = io_layout(1)*io_layout(2)
endif

clock_trw=mpp_clock_id( 'Icebergs-traj write', flags=clock_flag_default, grain=CLOCK_SUBCOMPONENT )
clock_trp=mpp_clock_id( 'Icebergs-traj prepare', flags=clock_flag_default, grain=CLOCK_SUBCOMPONENT )

end subroutine ice_bergs_io_init

! ##############################################################################
Expand Down Expand Up @@ -838,18 +848,21 @@ subroutine write_trajectory(trajectory)
stderrunit=stderr()

!Assemble the list of trajectories from all pes in this I/O tile
call mpp_clock_begin(clock_trp)

!First add the trajs on the io_tile_root_pe (if any) to the I/O list
if(is_io_tile_root_pe) then
if(is_io_tile_root_pe .OR. force_all_pes_traj ) then
if(associated(trajectory)) then
this=>trajectory
do while (associated(this))
call append_posn(traj4io, this)
call push_posn(traj4io, this)
this=>this%next
enddo
endif
endif

if(.NOT. force_all_pes_traj ) then

!Now gather and append the bergs from all pes in the io_tile to the list on corresponding io_tile_root_pe
ntrajs_sent_io =0
ntrajs_rcvd_io =0
Expand All @@ -867,6 +880,7 @@ subroutine write_trajectory(trajectory)
enddo
endif
enddo
! if(.NOT. reverse_traj .AND. associated(traj4io)) call reverse_list(traj4io)
else
!Pack and Send trajs to the root pe for this I/O tile
if (associated(trajectory)) then
Expand All @@ -885,14 +899,25 @@ subroutine write_trajectory(trajectory)
endif
endif

endif !.NOT. force_all_pes_traj

!Here traj4io has all the trajectories in completely reverse order (last position of the last berg first)
!If a correct order is prefered in the trajectory file then reverse the linked list
!This may increase the the termination time of the model by a lot!!!
if(is_io_tile_root_pe .OR. force_all_pes_traj ) then
if(.NOT. reverse_traj .AND. associated(traj4io)) call reverse_list(traj4io)
endif

call mpp_clock_end(clock_trp)


!Now start writing in the io_tile_root_pe if there are any bergs in the I/O list
call mpp_clock_begin(clock_trw)

if(is_io_tile_root_pe .AND. associated(traj4io)) then
if((force_all_pes_traj .OR. is_io_tile_root_pe) .AND. associated(traj4io)) then

call get_instance_filename("iceberg_trajectories.nc", filename)
if(io_tile_id(1) .ge. 0) then !io_tile_root_pes write
if(io_tile_id(1) .ge. 0 .AND. .NOT. force_all_pes_traj) then !io_tile_root_pes write
if(io_npes .gt. 1) then !attach tile_id to filename only if there is more than one I/O pe
if (io_tile_id(1)<10000) then
write(filename,'(A,".",I4.4)') trim(filename), io_tile_id(1)
Expand Down Expand Up @@ -1031,6 +1056,7 @@ subroutine write_trajectory(trajectory)
if (iret .ne. NF_NOERR) write(stderrunit,*) 'diamonds, write_trajectory: nf_close failed',mpp_pe(),filename

endif !(is_io_tile_root_pe .AND. associated(traj4io))
call mpp_clock_end(clock_trw)

end subroutine write_trajectory

Expand Down