| 1 | MODULE 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 icbdia ! iceberg diagnostics |
|---|
| 24 | USE icbutl ! iceberg utility routines |
|---|
| 25 | USE icb_oce ! iceberg parameters |
|---|
| 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 | !! * Substitutions |
|---|
| 34 | # include "do_loop_substitute.h90" |
|---|
| 35 | !!---------------------------------------------------------------------- |
|---|
| 36 | !! NEMO/OCE 4.0 , NEMO Consortium (2018) |
|---|
| 37 | !! $Id$ |
|---|
| 38 | !! Software governed by the CeCILL license (see ./LICENSE) |
|---|
| 39 | !!---------------------------------------------------------------------- |
|---|
| 40 | CONTAINS |
|---|
| 41 | |
|---|
| 42 | SUBROUTINE icb_clv_flx( kt ) |
|---|
| 43 | !!---------------------------------------------------------------------- |
|---|
| 44 | !! *** ROUTINE icb_clv_flx *** |
|---|
| 45 | !! |
|---|
| 46 | !! ** Purpose : accumulate ice available for calving into class arrays |
|---|
| 47 | !! |
|---|
| 48 | !!---------------------------------------------------------------------- |
|---|
| 49 | INTEGER, INTENT(in) :: kt |
|---|
| 50 | ! |
|---|
| 51 | REAL(wp) :: zcalving_used, zdist, zfact |
|---|
| 52 | INTEGER :: jn, ji, jj ! loop counters |
|---|
| 53 | INTEGER :: imx ! temporary integer for max berg class |
|---|
| 54 | LOGICAL, SAVE :: ll_first_call = .TRUE. |
|---|
| 55 | !!---------------------------------------------------------------------- |
|---|
| 56 | ! |
|---|
| 57 | ! Adapt calving flux and calving heat flux from coupler for use here |
|---|
| 58 | ! Use interior mask: so no bergs in overlap areas and convert from km^3/year to kg/s |
|---|
| 59 | ! this assumes that input is given as equivalent water flux so that pure water density is appropriate |
|---|
| 60 | |
|---|
| 61 | zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * rn_rho_bergs |
|---|
| 62 | berg_grid%calving(:,:) = src_calving(:,:) * zfact * tmask_i(:,:) * tmask(:,:,1) |
|---|
| 63 | |
|---|
| 64 | ! Heat in units of W/m2, and mask (just in case) |
|---|
| 65 | berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:) * tmask(:,:,1) |
|---|
| 66 | |
|---|
| 67 | IF( ll_first_call .AND. .NOT. l_restarted_bergs ) THEN ! This is a hack to simplify initialization |
|---|
| 68 | ll_first_call = .FALSE. |
|---|
| 69 | !do jn=1, nclasses |
|---|
| 70 | ! where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0. |
|---|
| 71 | !end do |
|---|
| 72 | DO_2D( 0, 0, 0, 0 ) |
|---|
| 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_2D |
|---|
| 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_2D( 1, 1, 1, 1 ) |
|---|
| 83 | imx = berg_grid%maxclass(ji,jj) |
|---|
| 84 | zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) ) |
|---|
| 85 | DO jn = 1, imx |
|---|
| 86 | berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) & |
|---|
| 87 | & + berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist |
|---|
| 88 | END DO |
|---|
| 89 | END_2D |
|---|
| 90 | |
|---|
| 91 | ! before changing the calving, save the amount we're about to use and do budget |
|---|
| 92 | zcalving_used = SUM( berg_grid%calving(:,:) ) |
|---|
| 93 | berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) |
|---|
| 94 | berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:) |
|---|
| 95 | CALL icb_dia_income( kt, zcalving_used, berg_grid%tmp ) |
|---|
| 96 | ! |
|---|
| 97 | END SUBROUTINE icb_clv_flx |
|---|
| 98 | |
|---|
| 99 | |
|---|
| 100 | SUBROUTINE icb_clv( kt ) |
|---|
| 101 | !!---------------------------------------------------------------------- |
|---|
| 102 | !! *** ROUTINE icb_clv *** |
|---|
| 103 | !! |
|---|
| 104 | !! ** Purpose : This routine takes a stored ice field and calves to the ocean, |
|---|
| 105 | !! so the gridded array stored_ice has only non-zero entries at selected |
|---|
| 106 | !! wet points adjacent to known land based calving points |
|---|
| 107 | !! |
|---|
| 108 | !! ** method : - Look at each grid point and see if there's enough for each size class to calve |
|---|
| 109 | !! If there is, a new iceberg is calved. This happens in the order determined by |
|---|
| 110 | !! the class definition arrays (which in the default case is smallest first) |
|---|
| 111 | !! Note that only the non-overlapping part of the processor where icebergs are allowed |
|---|
| 112 | !! is considered |
|---|
| 113 | !!---------------------------------------------------------------------- |
|---|
| 114 | INTEGER, INTENT(in) :: kt |
|---|
| 115 | INTEGER :: ji, jj, jn ! dummy loop indices |
|---|
| 116 | INTEGER :: icnt, icntmax |
|---|
| 117 | TYPE(iceberg) :: newberg |
|---|
| 118 | TYPE(point) :: newpt |
|---|
| 119 | REAL(wp) :: zday, zcalved_to_berg, zheat_to_berg |
|---|
| 120 | !!---------------------------------------------------------------------- |
|---|
| 121 | ! |
|---|
| 122 | icntmax = 0 |
|---|
| 123 | zday = REAL(nday_year,wp) + REAL(nsec_day,wp)/86400.0_wp |
|---|
| 124 | ! |
|---|
| 125 | DO jn = 1, nclasses |
|---|
| 126 | DO jj = nicbdj, nicbej |
|---|
| 127 | DO ji = nicbdi, nicbei |
|---|
| 128 | ! |
|---|
| 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 ) - ( nn_hls - 1 ) |
|---|
| 136 | newpt%yj = REAL( mjg(jj), wp ) - ( nn_hls - 1 ) |
|---|
| 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%kb = 1 ! compute correctly in icbthm if needed |
|---|
| 144 | newpt%width = first_width (jn) |
|---|
| 145 | newpt%length = first_length (jn) |
|---|
| 146 | newberg%mass_scaling = rn_mass_scaling (jn) |
|---|
| 147 | newpt%mass_of_bits = 0._wp ! no bergy |
|---|
| 148 | ! |
|---|
| 149 | newpt%year = nyear |
|---|
| 150 | newpt%day = zday |
|---|
| 151 | newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn) ! This is in J/kg |
|---|
| 152 | ! |
|---|
| 153 | CALL icb_utl_incr() |
|---|
| 154 | newberg%number(:) = num_bergs(:) |
|---|
| 155 | ! |
|---|
| 156 | CALL icb_utl_add( newberg, newpt ) |
|---|
| 157 | ! |
|---|
| 158 | zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn) ! Units of kg |
|---|
| 159 | ! ! Heat content |
|---|
| 160 | zheat_to_berg = zcalved_to_berg * newpt%heat_density ! Units of J |
|---|
| 161 | berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - zheat_to_berg |
|---|
| 162 | ! ! Stored mass |
|---|
| 163 | berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) - zcalved_to_berg |
|---|
| 164 | ! |
|---|
| 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 | IF( nn_verbose_level > 0 .AND. icntmax > 1 ) WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea |
|---|
| 175 | ! |
|---|
| 176 | END SUBROUTINE icb_clv |
|---|
| 177 | |
|---|
| 178 | !!====================================================================== |
|---|
| 179 | END MODULE icbclv |
|---|
