source: branches/UKMO/dev_r5518_GO6_package_isfprint/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90 @ 13072

Last change on this file since 13072 was 13072, checked in by timgraham, 16 months ago

Commit all functional changes

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