MODULE icbrun !!====================================================================== !! *** MODULE icbrun *** !! Ocean physics: initialise variables for iceberg tracking !!====================================================================== !! History : 3.3.1 ! 2010-01 (Martin&Adcroft) Original code !! - ! 2011-03 (Madec) Part conversion to NEMO form !! - ! Removal of mapping from another grid !! - ! 2011-04 (Alderson) Split into separate modules !! - ! Move budgets to icbdia routine !! - ! 2011-05 (Alderson) Add call to copy forcing arrays !! - ! into icb copies with haloes !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! icb_stp : start iceberg tracking !! icb_end : end iceberg tracking !!---------------------------------------------------------------------- USE par_oce ! nemo parameters USE dom_oce ! ocean domain USE sbc_oce ! ocean surface forcing USE phycst USE in_out_manager ! nemo IO USE lib_mpp USE iom USE icb_oce ! define iceberg arrays USE icbini ! iceberg initialisation routines USE icbutl ! iceberg utility routines USE icbrst ! iceberg restart routines USE icbdyn ! iceberg dynamics (ie advection) routines USE icbclv ! iceberg calving routines USE icbthm ! iceberg thermodynamics routines USE icblbc ! iceberg lateral boundary routines (including mpp) USE icbtrj ! iceberg trajectory I/O routines USE icbdia ! iceberg budget IMPLICIT NONE PRIVATE PUBLIC icb_stp ! routine called in sbcmod.F90 module PUBLIC icb_end ! routine called in nemogcm.F90 module CONTAINS SUBROUTINE icb_stp( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE icb_stp *** !! !! ** Purpose : iceberg time stepping. !! !! ** Method : - blah blah !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! INTEGER :: iyr, imon, iday, ihr, imin, isec LOGICAL :: ll_sample_traj, ll_budget, ll_verbose !!---------------------------------------------------------------------- !! start of timestep housekeeping nktberg = kt ! read calving data IF( nn_test_icebergs < 0 ) THEN ! CALL fld_read ( kt, 1, sf_icb ) src_calving(:,:) = sf_icb(1)%fnow(:,:,1) ! calving in km^3/year (water equivalent) src_calving_hflx(:,:) = 0._wp ! NO heat flux for now ! ENDIF berg_grid%floating_melt(:,:) = 0._wp ! anything that needs to be reset to zero each timestep for budgets is dealt with here CALL icb_budget_step() ! Manage time ! Convert nemo time variables from dom_oce into local versions ! Note that yearday function assumes 365 day year!! iyr = nyear imon = nmonth iday = nday ihr = INT(nsec_day/3600) imin = INT((nsec_day-ihr*3600)/60) isec = nsec_day - ihr*3600 - imin*60 current_year = iyr current_yearday = yearday(imon, iday, ihr, imin, isec) ll_verbose = .FALSE. IF( nn_verbose_write .GT. 0 .AND. & MOD(kt-1,nn_verbose_write ) == 0 ) ll_verbose = nn_verbose_level >= 0 IF( ll_verbose ) WRITE(numicb,9100) iyr, imon, iday, ihr, imin, isec, & current_year, current_yearday 9100 FORMAT('y,m,d=',3i5,' h,m,s=',3i5,' yr,yrdy=',i5,f8.3) ! copy nemo forcing arrays into iceberg versions with extra halo ! only necessary for variables not on T points CALL copy_flds() !!---------------------------------------------------------------------- !! process icebergs ! Accumulate ice from calving CALL accumulate_calving( kt ) ! Calve excess stored ice into icebergs CALL calve_icebergs() ! !== For each berg, evolve ==! ! IF( ASSOCIATED(first_berg) ) CALL evolve_icebergs() ! ice berg dynamics IF( lk_mpp ) THEN CALL mpp_send_bergs () ! Send bergs to other PEs ELSE CALL lbc_send_bergs() ! Deal with any cyclic boundaries in non-mpp case ENDIF IF( ASSOCIATED(first_berg) ) CALL thermodynamics ( kt ) ! Ice berg thermodynamics (melting) + rolling !!---------------------------------------------------------------------- !! end of timestep housekeeping ll_sample_traj = .FALSE. IF( nn_sample_rate .GT. 0 .AND. MOD(kt-1,nn_sample_rate) == 0 ) ll_sample_traj = .TRUE. IF( ll_sample_traj .AND. & ASSOCIATED(first_berg) ) CALL traj_write ( kt ) ! For each berg, record trajectory ! Gridded diagnostics ! To get these iom_put's and those preceding to actually do something ! use key_iomput in cpp file and create content for XML file CALL iom_put( "calving" , berg_grid%calving (:,:) ) ! 'calving mass input' CALL iom_put( "berg_floating_melt", berg_grid%floating_melt(:,:) ) ! 'Melt rate of icebergs + bits' , 'kg/m2/s' CALL iom_put( "berg_stored_ice" , berg_grid%stored_ice (:,:,:) ) ! 'Accumulated ice mass by class', 'kg' ! write out mean budgets - not sure why this happens before they are calculated - sga ! CALL icb_budget_put() ! Dump icebergs to screen if ( nn_verbose_level >= 2 ) CALL print_bergs( 'icb_stp, status', kt ) ! Diagnose budgets ll_budget = .FALSE. IF( nn_verbose_write .GT. 0 .AND. MOD(kt-1,nn_verbose_write) == 0 ) ll_budget = ln_bergdia CALL icb_budget( ll_budget ) IF( MOD(kt,nn_stock) == 0 ) THEN CALL icebergs_write_restart( kt ) IF( nn_sample_rate .GT. 0 ) CALL traj_sync() ENDIF ! END SUBROUTINE icb_stp !!------------------------------------------------------------------------- SUBROUTINE icb_end( kt ) ! Arguments INTEGER, INTENT( in ) :: kt ! Local variables TYPE(iceberg), POINTER :: this, next ! expanded arrays for bilinear interpolation DEALLOCATE( uo_e ) DEALLOCATE( vo_e ) DEALLOCATE( ff_e ) DEALLOCATE( ua_e ) DEALLOCATE( va_e ) #if defined key_lim2 || defined key_lim3 DEALLOCATE( ui_e ) DEALLOCATE( vi_e ) #endif DEALLOCATE( ssh_e ) DEALLOCATE( nicbfldpts ) DEALLOCATE( nicbflddest ) DEALLOCATE( nicbfldproc ) IF( lk_mpp ) CALL dealloc_buffers() IF (.NOT.ASSOCIATED(berg_grid)) RETURN ! only write a restart if not done in icb_stp IF( MOD(kt,nn_stock) .NE. 0 ) CALL icebergs_write_restart( kt ) ! finish with trajectories if they were written IF( nn_sample_rate .GT. 0 ) CALL traj_end() ! Delete bergs and structures this=>first_berg DO WHILE (ASSOCIATED(this)) next=>this%next CALL destroy_iceberg(this) this=>next ENDDO CALL icb_budget_end() DEALLOCATE(berg_grid%calving) DEALLOCATE(berg_grid%calving_hflx) DEALLOCATE(berg_grid%stored_heat) DEALLOCATE(berg_grid%floating_melt) DEALLOCATE(berg_grid%maxclass) DEALLOCATE(berg_grid%tmp) DEALLOCATE(berg_grid%stored_ice) DEALLOCATE(berg_grid) DEALLOCATE(first_width) DEALLOCATE(first_length) IF (lwp) WRITE(numout,'(a,i6)') 'icebergs: icb_end complete',narea CALL flush( numicb ) CLOSE( numicb ) END SUBROUTINE icb_end !!------------------------------------------------------------------------- END MODULE icbrun