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 @ 3339

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

NEMO branch dev_r3337_NOCS10_ICB: add new iceberg sub-directory ICB
File size: 9.0 KB
Line 
1MODULE icbclv
2
3   !!======================================================================
4   !!                       ***  MODULE  icbclv  ***
5   !! Ocean physics:  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   !!   accumulate_calving      :
15   !!   icb_gen       : generate test icebergs
16   !!   icb_nam       : read iceberg namelist
17   !!----------------------------------------------------------------------
18   USE par_oce        ! NEMO parameters
19   USE dom_oce        ! NEMO ocean domain
20   USE phycst         ! NEMO physical constants
21   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
22   USE lbclnk         ! NEMO boundary exchanges for gridded data
23
24   USE icb_oce        ! define iceberg arrays
25   USE icbdia         ! iceberg utility routines
26   USE icbutl         ! iceberg utility routines
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   accumulate_calving  ! routine called in xxx.F90 module
32   PUBLIC   calve_icebergs      ! routine called in xxx.F90 module
33
34CONTAINS
35
36   SUBROUTINE accumulate_calving( kt )
37      !!----------------------------------------------------------------------
38      !!                 ***  ROUTINE accumulate_calving  ***
39      !!
40      !! ** Purpose :   ?
41      !!
42      !! ** input   : - ?
43      !!----------------------------------------------------------------------
44      !
45      INTEGER                         :: kt
46      REAL(wp)                        :: calving_used, rdist, ufact
47      INTEGER                         :: jn, ji, jj, nmax
48      LOGICAL, SAVE                   :: first_call = .TRUE.
49      !!----------------------------------------------------------------------
50      !
51      ! Adapt calving flux and calving heat flux from coupler for use here
52      ! Use interior mask: so no bergs in overlap areas and convert from km^3/year to kg/s
53      ! this assumes that input is given as equivalent water flux so that pure water density is appropriate
54      ufact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * 1000._wp
55      berg_grid%calving(:,:) = p_calving(:,:) * tmask_i(:,:) * ufact
56
57      ! Heat in units of W/m2, and mask (just in case)
58      berg_grid%calving_hflx(:,:) = p_calving_hflx(:,:) * tmask_i(:,:)
59
60      IF( first_call .AND. .NOT.restarted_bergs) THEN      ! This is a hack to simplify initialization
61         first_call = .FALSE.
62         !do jn=1, nclasses
63         !  where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0.
64         !enddo
65         DO jj = 2, jpjm1
66            DO ji = 2, jpim1
67               IF( berg_grid%calving(ji,jj) /= 0._wp )                                  &    ! Need units of J
68                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &  ! initial stored ice in kg
69                                         berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) /   &  ! J/s/m2 x m^2 = J/s
70                                         berg_grid%calving(ji,jj)                            ! /calving in kg/s
71            END DO
72         END DO
73      ENDIF
74
75      ! assume that all calving flux must be distributed even if distribution array does not sum
76      ! to one - this may not be what is intended, but it's what you've got
77      DO jj = 1,jpj
78         DO ji = 1,jpi
79            nmax = berg_grid%maxclass(ji,jj)
80            rdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:nmax) )
81            DO jn = 1, nmax
82               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) + &
83                                          berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * rdist
84            END DO
85         END DO
86      END DO
87
88      ! before changing the calving, save the amount we're about to use and do budget
89      calving_used = SUM( berg_grid%calving(:,:) )
90      berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:)
91      berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:)
92      CALL incoming_budget( kt,  calving_used, berg_grid%tmp )
93      !
94   END SUBROUTINE accumulate_calving
95
96! ##############################################################################
97
98   SUBROUTINE calve_icebergs()
99      !!----------------------------------------------------------------------
100      !!                 ***  ROUTINE calve_icebergs  ***
101      !!
102      !! ** Purpose :   This seems to be the routine that takes a stored ice field and calves to the ocean,
103      !!                so I assume that the gridded array stored_ice has only non-zero entries at selected
104      !!                wet points adjacent to known land based calving points
105      !!
106      !! ** method  : - Look at each grid point and see if there's enough for each size class to calve
107      !!                If there is, a new iceberg is calved.  This happens in the order determined by
108      !!                the class definition arrays (largest first?)
109      !!                Note that only the non-overlapping part of the processor where icebergs are allowed
110      !!                is considered
111      !!----------------------------------------------------------------------
112      !
113      INTEGER                         ::   icnt,icntmax
114      TYPE(iceberg)                   ::   newberg
115      TYPE(point)                     ::   newpt
116      LOGICAL                         ::   lret
117      INTEGER                         ::   ji, jj, jn   ! dummy loop indices
118      REAL(wp)                        ::   xi, yj, ddt, calved_to_berg, heat_to_berg
119      !!----------------------------------------------------------------------
120
121      icntmax          = 0
122
123      DO jn = 1, nclasses
124         DO jj = icbdj, icbej
125            DO ji = icbdi, icbei
126               !
127               ddt  = 0._wp
128               icnt = 0
129               !
130               DO WHILE (berg_grid%stored_ice(ji,jj,jn) >= rn_initial_mass(jn) * rn_mass_scaling(jn) )
131                  !
132                  newpt%lon = glamt(ji,jj)       ! at t-point (centre of the cell)
133                  newpt%lat = gphit(ji,jj)
134                  newpt%xi  = REAL( nimpp+ji-1, wp )
135                  newpt%yj  = REAL( njmpp+jj-1, wp )
136                  !
137                  newpt%uvel = 0._wp             ! initially at rest
138                  newpt%vvel = 0._wp
139                  !                                ! set berg characteristics
140                  newpt%mass         = rn_initial_mass     (jn)
141                  newpt%thickness    = rn_initial_thickness(jn)
142                  newpt%width        = initial_width    (jn)
143                  newpt%length       = initial_length   (jn)
144                  newberg%mass_scaling = rn_mass_scaling     (jn)
145                  newpt%mass_of_bits = 0._wp                          ! no bergy
146                  !
147                  newpt%year   = current_year
148                  newpt%day    = current_yearday + ddt / rday
149                  newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn)   ! This is in J/kg
150                  !
151                  CALL increment_kounter()
152                  newberg%number(:) = kount_bergs(:)
153                  !
154                  CALL add_new_berg_to_list( newberg, newpt )
155                  !
156                  calved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn)           ! Units of kg
157                  !                                ! Heat content
158                  heat_to_berg           = calved_to_berg * newpt%heat_density             ! Units of J
159                  berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - heat_to_berg
160                  !                                ! Stored mass
161                  berg_grid%stored_ice(ji,jj,jn)   = berg_grid%stored_ice(ji,jj,jn) - calved_to_berg
162                  !
163                  ddt  = ddt + berg_dt * 2._wp / 17._wp    ! Minor offset to start day    !!gm why???
164                  icnt = icnt + 1
165                  !
166                  CALL calving_budget(ji, jj, jn,  calved_to_berg, heat_to_berg )
167               END DO
168               icntmax = MAX( icntmax, icnt )
169            END DO
170         END DO
171      END DO
172      !
173      DO jn = 1,nclasses
174         CALL lbc_lnk( berg_grid%stored_ice(:,:,jn), 'T', 1._wp )
175      ENDDO
176      CALL lbc_lnk( berg_grid%stored_heat, 'T', 1._wp )
177      !
178      IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'calve_icebergs: icnt=', icnt,' on', narea
179      !
180   END SUBROUTINE  calve_icebergs
181
182END MODULE icbclv
Note: See TracBrowser for help on using the repository browser.