source: branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbrun.F90 @ 3339

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 xxx.F90 module
   PUBLIC   icb_end        ! routine called in xxx.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                         ::   lerr, sample_traj, l_budget, l_verbose
      !!----------------------------------------------------------------------
      !! start of timestep housekeeping

      ktberg = kt

      ! read calving data
      IF( nn_test_icebergs < 0 ) THEN
         !
         CALL fld_read ( kt, 1, sf_icb )
         p_calving(:,:)      = sf_icb(1)%fnow(:,:,1)    ! calving in km^3/year (water equivalent)
         p_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)

      l_verbose = .FALSE.
      IF( nn_verbose_write .GT. 0 .AND. &
          MOD(kt-1,nn_verbose_write ) == 0 ) l_verbose = nn_verbose_level >= 0
      IF( l_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

      sample_traj = .FALSE.
      IF( nn_sample_rate .GT. 0 .AND. MOD(kt-1,nn_sample_rate) == 0 )   sample_traj = .TRUE.
      IF( 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
      l_budget = .FALSE.
      IF( nn_verbose_write .GT. 0 .AND. MOD(kt-1,nn_verbose_write) == 0 )   l_budget = ln_bergdia
      CALL icb_budget( l_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( icbfldpts )

      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(initial_width)
      DEALLOCATE(initial_length)

      IF (lwp) WRITE(numout,'(a,i6)') 'icebergs: icb_end complete',narea
      CALL flush( numicb )
      CLOSE( numicb )

   END SUBROUTINE icb_end

   !!-------------------------------------------------------------------------

END MODULE icbrun