diff --git a/icebergs_framework.F90 b/icebergs_framework.F90 index 48dfe14..239b8ac 100644 --- a/icebergs_framework.F90 +++ b/icebergs_framework.F90 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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) @@ -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 @@ -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 diff --git a/icebergs_io.F90 b/icebergs_io.F90 index 154fca6..3a4bdc6 100644 --- a/icebergs_io.F90 +++ b/icebergs_io.F90 @@ -16,12 +16,17 @@ 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 @@ -29,7 +34,7 @@ module ice_bergs_io 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 @@ -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 @@ -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 ! ############################################################################## @@ -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 @@ -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 @@ -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) @@ -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