source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90 @ 8046

Last change on this file since 8046 was 8046, checked in by davestorkey, 3 years ago

UKMO/dev_r5518_GO6_package branch: Add extra option for freshwater input from ice shelves in coupled models.

File size: 11.5 KB
Line 
1MODULE icbclv
2
3   !!======================================================================
4   !!                       ***  MODULE  icbclv  ***
5   !! Icebergs:  calving routines for iceberg calving
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   !!            -    !  2011-05  (Alderson)       budgets into separate module
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
27   USE sbc_oce        ! for icesheet freshwater input variables
28   USE in_out_manager
29   USE iom
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   icb_clv_flx  ! routine called in icbstp.F90 module
35   PUBLIC   icb_clv      ! routine called in icbstp.F90 module
36
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE icb_clv_flx( kt )
45      !!----------------------------------------------------------------------
46      !!                 ***  ROUTINE icb_clv_flx  ***
47      !!
48      !! ** Purpose :   accumulate ice available for calving into class arrays
49      !!
50      !!----------------------------------------------------------------------
51      INTEGER, INTENT(in)             :: kt
52      !
53      REAL(wp)                        :: zcalving_used, zdist, zfact
54      REAL(wp)                        :: zgreenland_calving_sum, zantarctica_calving_sum
55      INTEGER                         :: jn, ji, jj                    ! loop counters
56      INTEGER                         :: imx                           ! temporary integer for max berg class
57      LOGICAL, SAVE                   :: ll_first_call = .TRUE.
58      !!----------------------------------------------------------------------
59      !
60      ! Adapt calving flux and calving heat flux from coupler for use here
61      ! Use interior mask: so no bergs in overlap areas and convert from km^3/year to kg/s
62      ! this assumes that input is given as equivalent water flux so that pure water density is appropriate
63
64      zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * 850._wp
65      berg_grid%calving(:,:) = src_calving(:,:) * tmask_i(:,:) * zfact
66
67      IF( lk_oasis) THEN
68      ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true
69      IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN
70
71        ! Adjust total calving rates so that sum of iceberg calving and iceshelf melting in the northern
72        ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets
73        ! to preserve total freshwater conservation in coupled models without an active ice sheet model.
74
75         zgreenland_calving_sum = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) )
76         IF( lk_mpp ) CALL mpp_sum( zgreenland_calving_sum )
77         WHERE( greenland_icesheet_mask(:,:) == 1.0 )                                                                                 &
78        &    berg_grid%calving(:,:) = berg_grid%calving(:,:) * greenland_icesheet_mass_rate_of_change * rn_greenland_calving_fraction &
79        &                                     / ( zgreenland_calving_sum + 1.0e-10_wp )
80
81         ! check
82         IF(lwp) WRITE(numout, *) 'Greenland iceberg calving climatology (kg/s) : ',zgreenland_calving_sum
83         zgreenland_calving_sum = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) )
84         IF( lk_mpp ) CALL mpp_sum( zgreenland_calving_sum )
85         IF(lwp) WRITE(numout, *) 'Greenland iceberg calving adjusted value (kg/s) : ',zgreenland_calving_sum
86
87         zantarctica_calving_sum = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) )
88         IF( lk_mpp ) CALL mpp_sum( zantarctica_calving_sum )
89         WHERE( antarctica_icesheet_mask(:,:) == 1.0 )                                                                              &
90         berg_grid%calving(:,:) = berg_grid%calving(:,:) * antarctica_icesheet_mass_rate_of_change * rn_antarctica_calving_fraction &
91        &                           / ( zantarctica_calving_sum + 1.0e-10_wp )
92 
93         ! check
94         IF(lwp) WRITE(numout, *) 'Antarctica iceberg calving climatology (kg/s) : ',zantarctica_calving_sum
95         zantarctica_calving_sum = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) )
96         IF( lk_mpp ) CALL mpp_sum( zantarctica_calving_sum )
97         IF(lwp) WRITE(numout, *) 'Antarctica iceberg calving adjusted value (kg/s) : ',zantarctica_calving_sum
98
99      ENDIF
100      ENDIF
101   
102      CALL iom_put( 'berg_calve', berg_grid%calving(:,:) )
103
104      ! Heat in units of W/m2, and mask (just in case)
105      berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:)
106
107      IF( ll_first_call .AND. .NOT. l_restarted_bergs) THEN      ! This is a hack to simplify initialization
108         ll_first_call = .FALSE.
109         !do jn=1, nclasses
110         !  where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0.
111         !end do
112         DO jj = 2, jpjm1
113            DO ji = 2, jpim1
114               IF( berg_grid%calving(ji,jj) /= 0._wp )                                  &    ! Need units of J
115                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &  ! initial stored ice in kg
116                                         berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) /   &  ! J/s/m2 x m^2 = J/s
117                                         berg_grid%calving(ji,jj)                            ! /calving in kg/s
118            END DO
119         END DO
120      ENDIF
121
122      ! assume that all calving flux must be distributed even if distribution array does not sum
123      ! to one - this may not be what is intended, but it's what you've got
124      DO jj = 1,jpj
125         DO ji = 1,jpi
126            imx = berg_grid%maxclass(ji,jj)
127            zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) )
128            DO jn = 1, imx
129               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) + &
130                                          berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist
131            END DO
132         END DO
133      END DO
134
135      ! before changing the calving, save the amount we're about to use and do budget
136      zcalving_used = SUM( berg_grid%calving(:,:) )
137      berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:)
138      berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:)
139      CALL icb_dia_income( kt,  zcalving_used, berg_grid%tmp )
140      !
141   END SUBROUTINE icb_clv_flx
142
143   SUBROUTINE icb_clv()
144      !!----------------------------------------------------------------------
145      !!                 ***  ROUTINE icb_clv  ***
146      !!
147      !! ** Purpose :   This routine takes a stored ice field and calves to the ocean,
148      !!                so the gridded array stored_ice has only non-zero entries at selected
149      !!                wet points adjacent to known land based calving points
150      !!
151      !! ** method  : - Look at each grid point and see if there's enough for each size class to calve
152      !!                If there is, a new iceberg is calved.  This happens in the order determined by
153      !!                the class definition arrays (which in the default case is smallest first)
154      !!                Note that only the non-overlapping part of the processor where icebergs are allowed
155      !!                is considered
156      !!----------------------------------------------------------------------
157      INTEGER       ::   ji, jj, jn   ! dummy loop indices
158      INTEGER       ::   icnt, icntmax
159      TYPE(iceberg) ::   newberg
160      TYPE(point)   ::   newpt
161      REAL(wp)      ::   zday, zcalved_to_berg, zheat_to_berg
162      !!----------------------------------------------------------------------
163      !
164      icntmax = 0
165      zday    = REAL(nday_year,wp) + REAL(nsec_day,wp)/86400.0_wp
166      !
167      DO jn = 1, nclasses
168         DO jj = nicbdj, nicbej
169            DO ji = nicbdi, nicbei
170               !
171               icnt = 0
172               !
173               DO WHILE (berg_grid%stored_ice(ji,jj,jn) >= rn_initial_mass(jn) * rn_mass_scaling(jn) )
174                  !
175                  newpt%lon = glamt(ji,jj)         ! at t-point (centre of the cell)
176                  newpt%lat = gphit(ji,jj)
177                  newpt%xi  = REAL( mig(ji), wp )
178                  newpt%yj  = REAL( mjg(jj), wp )
179                  !
180                  newpt%uvel = 0._wp               ! initially at rest
181                  newpt%vvel = 0._wp
182                  !                                ! set berg characteristics
183                  newpt%mass           = rn_initial_mass     (jn)
184                  newpt%thickness      = rn_initial_thickness(jn)
185                  newpt%width          = first_width         (jn)
186                  newpt%length         = first_length        (jn)
187                  newberg%mass_scaling = rn_mass_scaling     (jn)
188                  newpt%mass_of_bits   = 0._wp                          ! no bergy
189                  !
190                  newpt%year   = nyear
191                  newpt%day    = zday
192                  newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn)   ! This is in J/kg
193                  !
194                  CALL icb_utl_incr()
195                  newberg%number(:) = num_bergs(:)
196                  !
197                  CALL icb_utl_add( newberg, newpt )
198                  !
199                  zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn)           ! Units of kg
200                  !                                ! Heat content
201                  zheat_to_berg           = zcalved_to_berg * newpt%heat_density             ! Units of J
202                  berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - zheat_to_berg
203                  !                                ! Stored mass
204                  berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) - zcalved_to_berg
205                  !
206                  icnt = icnt + 1
207                  !
208                  CALL icb_dia_calve(ji, jj, jn,  zcalved_to_berg, zheat_to_berg )
209               END DO
210               icntmax = MAX( icntmax, icnt )
211            END DO
212         END DO
213      END DO
214      !
215      DO jn = 1,nclasses
216         CALL lbc_lnk( berg_grid%stored_ice(:,:,jn), 'T', 1._wp )
217      END DO
218      CALL lbc_lnk( berg_grid%stored_heat, 'T', 1._wp )
219      !
220      IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea
221      !
222   END SUBROUTINE  icb_clv
223
224   !!======================================================================
225END MODULE icbclv
Note: See TracBrowser for help on using the repository browser.