source: NEMO/branches/UKMO/NEMO_4.0_GO8_package_text_diagnostics/src/OCE/ICB/icbclv.F90 @ 10948

Last change on this file since 10948 was 10948, checked in by andmirek, 19 months ago

GMED 462 iceberg model

File size: 9.1 KB
Line 
1MODULE icbclv
2   !!======================================================================
3   !!                       ***  MODULE  icbclv  ***
4   !! Icebergs:  calving routines for iceberg calving
5   !!======================================================================
6   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
7   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
8   !!            -    !                            Removal of mapping from another grid
9   !!            -    !  2011-04  (Alderson)       Split into separate modules
10   !!            -    !  2011-05  (Alderson)       budgets into separate module
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   icb_clv_flx   : transfer input flux of ice into iceberg classes
15   !!   icb_clv       : calve icebergs from stored ice
16   !!----------------------------------------------------------------------
17   USE par_oce        ! NEMO parameters
18   USE dom_oce        ! NEMO ocean domain
19   USE phycst         ! NEMO physical constants
20   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
21   USE lbclnk         ! NEMO boundary exchanges for gridded data
22
23   USE icb_oce        ! iceberg variables
24   USE icbdia         ! iceberg diagnostics
25   USE icbutl         ! iceberg utility routines
26   USE icb_oce        ! iceberg parameters
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   icb_clv_flx  ! routine called in icbstp.F90 module
32   PUBLIC   icb_clv      ! routine called in icbstp.F90 module
33
34   !!----------------------------------------------------------------------
35   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
36   !! $Id$
37   !! Software governed by the CeCILL license (see ./LICENSE)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE icb_clv_flx( kt )
42      !!----------------------------------------------------------------------
43      !!                 ***  ROUTINE icb_clv_flx  ***
44      !!
45      !! ** Purpose :   accumulate ice available for calving into class arrays
46      !!
47      !!----------------------------------------------------------------------
48      INTEGER, INTENT(in) ::   kt
49      !
50      REAL(wp)      ::   zcalving_used, zdist, zfact
51      INTEGER       ::   jn, ji, jj                    ! loop counters
52      INTEGER       ::   imx                           ! temporary integer for max berg class
53      LOGICAL, SAVE ::   ll_first_call = .TRUE.
54      !!----------------------------------------------------------------------
55      !
56      ! Adapt calving flux and calving heat flux from coupler for use here
57      ! Use interior mask: so no bergs in overlap areas and convert from km^3/year to kg/s
58      ! this assumes that input is given as equivalent water flux so that pure water density is appropriate
59
60      zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * rn_rho_bergs
61      berg_grid%calving(:,:) = src_calving(:,:) * zfact * tmask_i(:,:) * tmask(:,:,1)
62
63      ! Heat in units of W/m2, and mask (just in case)
64      berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:) * tmask(:,:,1)
65
66      IF( ll_first_call .AND. .NOT. l_restarted_bergs ) THEN      ! This is a hack to simplify initialization
67         ll_first_call = .FALSE.
68         !do jn=1, nclasses
69         !  where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0.
70         !end do
71         DO jj = 2, jpjm1
72            DO ji = 2, jpim1
73               IF( berg_grid%calving(ji,jj) /= 0._wp )                                          &    ! Need units of J
74                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &    ! initial stored ice in kg
75                     &                   berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) / berg_grid%calving(ji,jj)   ! J/s/m2 x m^2
76                     !                                                                                             ! = J/s/calving in kg/s
77            END DO
78         END DO
79      ENDIF
80
81      ! assume that all calving flux must be distributed even if distribution array does not sum
82      ! to one - this may not be what is intended, but it's what you've got
83      DO jj = 1, jpj
84         DO ji = 1, jpi
85            imx = berg_grid%maxclass(ji,jj)
86            zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) )
87            DO jn = 1, imx
88               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn)     &
89                  &                           + berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist
90            END DO
91         END DO
92      END DO
93
94      ! before changing the calving, save the amount we're about to use and do budget
95      zcalving_used = SUM( berg_grid%calving(:,:) )
96      berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:)
97      berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:)
98      CALL icb_dia_income( kt,  zcalving_used, berg_grid%tmp )
99      !
100   END SUBROUTINE icb_clv_flx
101
102
103   SUBROUTINE icb_clv( kt )
104      !!----------------------------------------------------------------------
105      !!                 ***  ROUTINE icb_clv  ***
106      !!
107      !! ** Purpose :   This routine takes a stored ice field and calves to the ocean,
108      !!                so the gridded array stored_ice has only non-zero entries at selected
109      !!                wet points adjacent to known land based calving points
110      !!
111      !! ** method  : - Look at each grid point and see if there's enough for each size class to calve
112      !!                If there is, a new iceberg is calved.  This happens in the order determined by
113      !!                the class definition arrays (which in the default case is smallest first)
114      !!                Note that only the non-overlapping part of the processor where icebergs are allowed
115      !!                is considered
116      !!----------------------------------------------------------------------
117      INTEGER, INTENT(in) ::   kt
118      INTEGER       ::   ji, jj, jn   ! dummy loop indices
119      INTEGER       ::   icnt, icntmax
120      TYPE(iceberg) ::   newberg
121      TYPE(point)   ::   newpt
122      REAL(wp)      ::   zday, zcalved_to_berg, zheat_to_berg
123      !!----------------------------------------------------------------------
124      !
125      icntmax = 0
126      zday    = REAL(nday_year,wp) + REAL(nsec_day,wp)/86400.0_wp
127      !
128      DO jn = 1, nclasses
129         DO jj = nicbdj, nicbej
130            DO ji = nicbdi, nicbei
131               !
132               icnt = 0
133               !
134               DO WHILE (berg_grid%stored_ice(ji,jj,jn) >= rn_initial_mass(jn) * rn_mass_scaling(jn) )
135                  !
136                  newpt%lon = glamt(ji,jj)         ! at t-point (centre of the cell)
137                  newpt%lat = gphit(ji,jj)
138                  newpt%xi  = REAL( mig(ji), wp )
139                  newpt%yj  = REAL( mjg(jj), wp )
140                  !
141                  newpt%uvel = 0._wp               ! initially at rest
142                  newpt%vvel = 0._wp
143                  !                                ! set berg characteristics
144                  newpt%mass           = rn_initial_mass     (jn)
145                  newpt%thickness      = rn_initial_thickness(jn)
146                  newpt%width          = first_width         (jn)
147                  newpt%length         = first_length        (jn)
148                  newberg%mass_scaling = rn_mass_scaling     (jn)
149                  newpt%mass_of_bits   = 0._wp                          ! no bergy
150                  !
151                  newpt%year   = nyear
152                  newpt%day    = zday
153                  newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn)   ! This is in J/kg
154                  !
155                  CALL icb_utl_incr()
156                  newberg%number(:) = num_bergs(:)
157                  !
158                  CALL icb_utl_add( newberg, newpt )
159                  !
160                  zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn)           ! Units of kg
161                  !                                ! Heat content
162                  zheat_to_berg           = zcalved_to_berg * newpt%heat_density             ! Units of J
163                  berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - zheat_to_berg
164                  !                                ! Stored mass
165                  berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) - zcalved_to_berg
166                  !
167                  icnt = icnt + 1
168                  !
169                  CALL icb_dia_calve(ji, jj, jn,  zcalved_to_berg, zheat_to_berg )
170               END DO
171               icntmax = MAX( icntmax, icnt )
172            END DO
173         END DO
174      END DO
175      !
176      DO jn = 1, nclasses
177         CALL lbc_lnk( 'icbclv', berg_grid%stored_ice(:,:,jn), 'T', 1._wp )
178      END DO
179      CALL lbc_lnk( 'icbclv', berg_grid%stored_heat, 'T', 1._wp )
180      !
181      IF( nn_verbose_level > 0 .AND. icntmax > 1 .AND. numicb.NE.-1)   WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea
182      !
183   END SUBROUTINE  icb_clv
184
185   !!======================================================================
186END MODULE icbclv
Note: See TracBrowser for help on using the repository browser.