New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
icbclv.F90 in branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB – NEMO

source: branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90 @ 3374

Last change on this file since 3374 was 3374, checked in by sga, 12 years ago

NEMO branch dev_r3337_NOCS10_ICB: adopt mig, mjg, mi1 and mj1 for improved obscurity

File size: 9.2 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   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   icb_clv_flx  ! routine called in icbstp.F90 module
31   PUBLIC   icb_clv      ! routine called in icbstp.F90 module
32
33   !!----------------------------------------------------------------------
34   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
35   !! $Id:$
36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
38CONTAINS
39
40   SUBROUTINE icb_clv_flx( kt )
41      !!----------------------------------------------------------------------
42      !!                 ***  ROUTINE icb_clv_flx  ***
43      !!
44      !! ** Purpose :   ?
45      !!
46      !! ** input   : - ?
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      zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * 1000._wp
60      berg_grid%calving(:,:) = src_calving(:,:) * tmask_i(:,:) * zfact
61
62      ! Heat in units of W/m2, and mask (just in case)
63      berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:)
64
65      IF( ll_first_call .AND. .NOT. l_restarted_bergs) THEN      ! This is a hack to simplify initialization
66         ll_first_call = .FALSE.
67         !do jn=1, nclasses
68         !  where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0.
69         !end do
70         DO jj = 2, jpjm1
71            DO ji = 2, jpim1
72               IF( berg_grid%calving(ji,jj) /= 0._wp )                                  &    ! Need units of J
73                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &  ! initial stored ice in kg
74                                         berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) /   &  ! J/s/m2 x m^2 = J/s
75                                         berg_grid%calving(ji,jj)                            ! /calving in kg/s
76            END DO
77         END DO
78      ENDIF
79
80      ! assume that all calving flux must be distributed even if distribution array does not sum
81      ! to one - this may not be what is intended, but it's what you've got
82      DO jj = 1,jpj
83         DO ji = 1,jpi
84            imx = berg_grid%maxclass(ji,jj)
85            zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) )
86            DO jn = 1, imx
87               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) + &
88                                          berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist
89            END DO
90         END DO
91      END DO
92
93      ! before changing the calving, save the amount we're about to use and do budget
94      zcalving_used = SUM( berg_grid%calving(:,:) )
95      berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:)
96      berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:)
97      CALL icb_dia_income( kt,  zcalving_used, berg_grid%tmp )
98      !
99   END SUBROUTINE icb_clv_flx
100
101   SUBROUTINE icb_clv()
102      !!----------------------------------------------------------------------
103      !!                 ***  ROUTINE icb_clv  ***
104      !!
105      !! ** Purpose :   This routine takes a stored ice field and calves to the ocean,
106      !!                so the gridded array stored_ice has only non-zero entries at selected
107      !!                wet points adjacent to known land based calving points
108      !!
109      !! ** method  : - Look at each grid point and see if there's enough for each size class to calve
110      !!                If there is, a new iceberg is calved.  This happens in the order determined by
111      !!                the class definition arrays (which in the default case is smallest first)
112      !!                Note that only the non-overlapping part of the processor where icebergs are allowed
113      !!                is considered
114      !!----------------------------------------------------------------------
115      INTEGER       ::   ji, jj, jn   ! dummy loop indices
116      INTEGER       ::   icnt, icntmax
117      TYPE(iceberg) ::   newberg
118      TYPE(point)   ::   newpt
119      REAL(wp)      ::   zddt, zcalved_to_berg, zheat_to_berg
120      !!----------------------------------------------------------------------
121      !
122      icntmax = 0
123      !
124      DO jn = 1, nclasses
125         DO jj = nicbdj, nicbej
126            DO ji = nicbdi, nicbei
127               !
128               zddt  = 0._wp
129               icnt = 0
130               !
131               DO WHILE (berg_grid%stored_ice(ji,jj,jn) >= rn_initial_mass(jn) * rn_mass_scaling(jn) )
132                  !
133                  newpt%lon = glamt(ji,jj)         ! at t-point (centre of the cell)
134                  newpt%lat = gphit(ji,jj)
135                  newpt%xi  = REAL( mig(ji), wp )
136                  newpt%yj  = REAL( mjg(jj), wp )
137                  !
138                  newpt%uvel = 0._wp               ! initially at rest
139                  newpt%vvel = 0._wp
140                  !                                ! set berg characteristics
141                  newpt%mass           = rn_initial_mass     (jn)
142                  newpt%thickness      = rn_initial_thickness(jn)
143                  newpt%width          = first_width         (jn)
144                  newpt%length         = first_length        (jn)
145                  newberg%mass_scaling = rn_mass_scaling     (jn)
146                  newpt%mass_of_bits   = 0._wp                          ! no bergy
147                  !
148                  newpt%year   = current_year
149                  newpt%day    = current_yearday + zddt / rday
150                  newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn)   ! This is in J/kg
151                  !
152                  CALL icb_utl_incr()
153                  newberg%number(:) = num_bergs(:)
154                  !
155                  CALL icb_utl_add( newberg, newpt )
156                  !
157                  zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn)           ! Units of kg
158                  !                                ! Heat content
159                  zheat_to_berg           = zcalved_to_berg * newpt%heat_density             ! Units of J
160                  berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - zheat_to_berg
161                  !                                ! Stored mass
162                  berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) - zcalved_to_berg
163                  !
164                  zddt  = zddt + berg_dt * 2._wp / 17._wp    ! Minor offset to start day    !!gm why???
165                  icnt = icnt + 1
166                  !
167                  CALL icb_dia_calve(ji, jj, jn,  zcalved_to_berg, zheat_to_berg )
168               END DO
169               icntmax = MAX( icntmax, icnt )
170            END DO
171         END DO
172      END DO
173      !
174      DO jn = 1,nclasses
175         CALL lbc_lnk( berg_grid%stored_ice(:,:,jn), 'T', 1._wp )
176      END DO
177      CALL lbc_lnk( berg_grid%stored_heat, 'T', 1._wp )
178      !
179      IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea
180      !
181   END SUBROUTINE  icb_clv
182
183   !!======================================================================
184END MODULE icbclv
Note: See TracBrowser for help on using the repository browser.