source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 12 months ago

The Dr Hook changes from my perl code.

File size: 7.8 KB
Line 
1MODULE icbstp
2
3   !!======================================================================
4   !!                       ***  MODULE  icbstp  ***
5   !! Icebergs:  initialise variables for iceberg tracking
6   !!======================================================================
7   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
8   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
9   !!            -    !                            Removal of mapping from another grid
10   !!            -    !  2011-04  (Alderson)       Split into separate modules
11   !!            -    !                            Move budgets to icbdia routine
12   !!            -    !  2011-05  (Alderson)       Add call to copy forcing arrays
13   !!            -    !                            into icb copies with haloes
14   !!----------------------------------------------------------------------
15   !!----------------------------------------------------------------------
16   !!   icb_stp       : start iceberg tracking
17   !!   icb_end       : end   iceberg tracking
18   !!----------------------------------------------------------------------
19   USE par_oce        ! nemo parameters
20   USE dom_oce        ! ocean domain
21   USE sbc_oce        ! ocean surface forcing
22   USE phycst
23   USE in_out_manager ! nemo IO
24   USE lib_mpp
25   USE iom
26   USE fldread
27   USE timing         ! timing
28
29   USE icb_oce        ! define iceberg arrays
30   USE icbini         ! iceberg initialisation routines
31   USE icbutl         ! iceberg utility routines
32   USE icbrst         ! iceberg restart routines
33   USE icbdyn         ! iceberg dynamics (ie advection) routines
34   USE icbclv         ! iceberg calving routines
35   USE icbthm         ! iceberg thermodynamics routines
36   USE icblbc         ! iceberg lateral boundary routines (including mpp)
37   USE icbtrj         ! iceberg trajectory I/O routines
38   USE icbdia         ! iceberg budget
39
40   USE yomhook, ONLY: lhook, dr_hook
41   USE parkind1, ONLY: jprb, jpim
42
43   IMPLICIT NONE
44   PRIVATE
45
46   PUBLIC   icb_stp        ! routine called in sbcmod.F90 module
47   PUBLIC   icb_end        ! routine called in nemogcm.F90 module
48
49   !!----------------------------------------------------------------------
50   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
51   !! $Id$
52   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
53   !!----------------------------------------------------------------------
54CONTAINS
55
56   SUBROUTINE icb_stp( kt )
57      !!----------------------------------------------------------------------
58      !!                  ***  ROUTINE icb_stp  ***
59      !!
60      !! ** Purpose :   iceberg time stepping.
61      !!
62      !! ** Method  : - top level routine to do things in the correct order
63      !!----------------------------------------------------------------------
64      INTEGER, INTENT(in) ::   kt   ! time step index
65      !
66      LOGICAL ::   ll_sample_traj, ll_budget, ll_verbose   ! local logical
67      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
68      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
69      REAL(KIND=jprb)               :: zhook_handle
70
71      CHARACTER(LEN=*), PARAMETER :: RoutineName='ICB_STP'
72
73      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
74
75      !!----------------------------------------------------------------------
76      !
77      IF( nn_timing == 1 ) CALL timing_start('icb_stp')
78
79      !! start of timestep housekeeping
80
81      nktberg = kt
82
83      IF( nn_test_icebergs < 0 ) THEN      ! read calving data
84         !
85         CALL fld_read ( kt, 1, sf_icb )
86         src_calving(:,:)      = sf_icb(1)%fnow(:,:,1)    ! calving in km^3/year (water equivalent)
87         src_calving_hflx(:,:) = 0._wp                    ! NO heat flux for now
88         !
89      ENDIF
90
91      berg_grid%floating_melt(:,:) = 0._wp
92
93      ! anything that needs to be reset to zero each timestep for budgets is dealt with here
94      CALL icb_dia_step()
95
96      ll_verbose = .FALSE.
97      IF( nn_verbose_write > 0 .AND. &
98          MOD(kt-1,nn_verbose_write ) == 0 )   ll_verbose = nn_verbose_level >= 0
99
100      ! write out time
101      IF( ll_verbose ) WRITE(numicb,9100) nktberg, ndastp, nsec_day
102 9100 FORMAT('kt= ',i8, ' day= ',i8,' secs=',i8)
103
104      ! copy nemo forcing arrays into iceberg versions with extra halo
105      ! only necessary for variables not on T points
106      CALL icb_utl_copy()
107
108      !!----------------------------------------------------------------------
109      !! process icebergs
110
111                                     CALL icb_clv_flx( kt )   ! Accumulate ice from calving
112
113                                     CALL icb_clv()           ! Calve excess stored ice into icebergs
114
115
116!                               !==  For each berg, evolve  ==!
117      !
118      IF( ASSOCIATED(first_berg) )   CALL icb_dyn( kt )       ! ice berg dynamics
119
120      IF( lk_mpp ) THEN          ;   CALL icb_lbc_mpp()       ! Send bergs to other PEs
121      ELSE                       ;   CALL icb_lbc()           ! Deal with any cyclic boundaries in non-mpp case
122      ENDIF
123
124      IF( ASSOCIATED(first_berg) )   CALL icb_thm( kt )       ! Ice berg thermodynamics (melting) + rolling
125
126      !!----------------------------------------------------------------------
127      !! end of timestep housekeeping
128
129      ll_sample_traj = .FALSE.
130      IF( nn_sample_rate > 0 .AND. MOD(kt-1,nn_sample_rate) == 0 )   ll_sample_traj = .TRUE.
131      IF( ll_sample_traj .AND.   &
132          ASSOCIATED(first_berg) )   CALL icb_trj_write( kt )  ! For each berg, record trajectory
133
134      ! Gridded diagnostics
135      ! To get these iom_put's and those preceding to actually do something
136      ! use key_iomput in cpp file and create content for XML file
137
138      CALL iom_put( "calving"           , berg_grid%calving      (:,:)   )  ! 'calving mass input'
139      CALL iom_put( "berg_floating_melt", berg_grid%floating_melt(:,:)   )  ! 'Melt rate of icebergs + bits' , 'kg/m2/s'
140      CALL iom_put( "berg_stored_ice"   , berg_grid%stored_ice   (:,:,:) )  ! 'Accumulated ice mass by class', 'kg'
141
142      ! store mean budgets
143      CALL icb_dia_put()
144
145      ! Dump icebergs to screen
146      if ( nn_verbose_level >= 2 )   CALL icb_utl_print( 'icb_stp, status', kt )
147
148      ! Diagnose budgets
149      ll_budget = .FALSE.
150      IF( nn_verbose_write > 0 .AND. MOD(kt-1,nn_verbose_write) == 0 )   ll_budget = ln_bergdia
151      CALL icb_dia( ll_budget )
152
153      IF( MOD(kt,nn_stock) == 0 ) THEN
154         CALL icb_rst_write( kt )
155         IF( nn_sample_rate > 0 )   CALL icb_trj_sync()
156      ENDIF
157
158      IF( nn_timing == 1 ) CALL timing_stop('icb_stp')
159      !
160      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
161   END SUBROUTINE icb_stp
162
163
164   SUBROUTINE icb_end( kt )
165      !!----------------------------------------------------------------------
166      !!                  ***  ROUTINE icb_end  ***
167      !!
168      !! ** Purpose :   close iceberg files
169      !!
170      !!----------------------------------------------------------------------
171      INTEGER, INTENT( in )  :: kt
172      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
173      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
174      REAL(KIND=jprb)               :: zhook_handle
175
176      CHARACTER(LEN=*), PARAMETER :: RoutineName='ICB_END'
177
178      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
179
180      !!----------------------------------------------------------------------
181
182      ! only write a restart if not done in icb_stp
183      IF( MOD(kt,nn_stock) .NE. 0 ) CALL icb_rst_write( kt )
184
185      ! finish with trajectories if they were written
186      IF( nn_sample_rate .GT. 0 ) CALL icb_trj_end()
187
188      IF(lwp)   WRITE(numout,'(a,i6)') 'icebergs: icb_end complete', narea
189      CALL flush( numicb )
190      CLOSE( numicb )
191      !
192      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
193   END SUBROUTINE icb_end
194
195   !!-------------------------------------------------------------------------
196
197END MODULE icbstp
Note: See TracBrowser for help on using the repository browser.