portedportable, not yet portedexecuted, not portableexecutable, not hit by this run
| 1 | ! This file is part of MOM6, the Modular Ocean Model version 6. | |
| 2 | ! See the LICENSE file for licensing information. | |
| 3 | ! SPDX-License-Identifier: Apache-2.0 | |
| 4 | ||
| 5 | !> Regrid columns for the continuous isopycnal (rho) coordinate | |
| 6 | module coord_rho | |
| 7 | ||
| 8 | use MOM_error_handler, only : MOM_error, FATAL | |
| 9 | use MOM_remapping, only : remapping_CS, remapping_core_h | |
| 10 | use MOM_EOS, only : EOS_type, calculate_density | |
| 11 | use regrid_interp, only : interp_CS_type, build_and_interpolate_grid, DEGREE_MAX | |
| 12 | ||
| 13 | implicit none ; private | |
| 14 | ||
| 15 | !> Control structure containing required parameters for the rho coordinate | |
| 16 | type, public :: rho_CS ; private | |
| 17 | ||
| 18 | !> Number of layers | |
| 19 | integer :: nk | |
| 20 | ||
| 21 | !> Minimum thickness allowed for layers, often in [H ~> m or kg m-2] | |
| 22 | real :: min_thickness = 0. | |
| 23 | ||
| 24 | !> Reference pressure for density calculations [R L2 T-2 ~> Pa] | |
| 25 | real :: ref_pressure | |
| 26 | ||
| 27 | !> If true, integrate for interface positions from the top downward. | |
| 28 | !! If false, integrate from the bottom upward, as does the rest of the model. | |
| 29 | logical :: integrate_downward_for_e = .false. | |
| 30 | ||
| 31 | !> Nominal density of interfaces [R ~> kg m-3] | |
| 32 | real, allocatable, dimension(:) :: target_density | |
| 33 | ||
| 34 | !> Interpolation control structure | |
| 35 | type(interp_CS_type) :: interp_CS | |
| 36 | end type rho_CS | |
| 37 | ||
| 38 | public init_coord_rho, set_rho_params, build_rho_column, old_inflate_layers_1d, end_coord_rho | |
| 39 | ||
| 40 | contains | |
| 41 | ||
| 42 | !> Initialise a rho_CS with pointers to parameters | |
| 43 | 0 | subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) |
| 44 | type(rho_CS), pointer :: CS !< Unassociated pointer to hold the control structure | |
| 45 | integer, intent(in) :: nk !< Number of layers in the grid | |
| 46 | real, intent(in) :: ref_pressure !< Coordinate reference pressure [R L2 T-2 ~> Pa] | |
| 47 | real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [R ~> kg m-3] | |
| 48 | type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation | |
| 49 | ||
| 50 | 0 | if (associated(CS)) call MOM_error(FATAL, "init_coord_rho: CS already associated!") |
| 51 | 0 | allocate(CS) |
| 52 | 0 | allocate(CS%target_density(nk+1)) |
| 53 | ||
| 54 | 0 | CS%nk = nk |
| 55 | 0 | CS%ref_pressure = ref_pressure |
| 56 | 0 | CS%target_density(:) = target_density(:) |
| 57 | 0 | CS%interp_CS = interp_CS |
| 58 | ||
| 59 | 0 | end subroutine init_coord_rho |
| 60 | ||
| 61 | !> This subroutine deallocates memory in the control structure for the coord_rho module | |
| 62 | 0 | subroutine end_coord_rho(CS) |
| 63 | type(rho_CS), pointer :: CS !< Coordinate control structure | |
| 64 | ||
| 65 | ! nothing to do | |
| 66 | 0 | if (.not. associated(CS)) return |
| 67 | 0 | deallocate(CS%target_density) |
| 68 | 0 | deallocate(CS) |
| 69 | end subroutine end_coord_rho | |
| 70 | ||
| 71 | !> This subroutine can be used to set the parameters for the coord_rho module | |
| 72 | 0 | subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS, ref_pressure) |
| 73 | type(rho_CS), pointer :: CS !< Coordinate control structure | |
| 74 | real, optional, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] | |
| 75 | logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface | |
| 76 | !! positions from the top downward. If false, integrate | |
| 77 | !! from the bottom upward, as does the rest of the model. | |
| 78 | real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent | |
| 79 | !! coordinates [R L2 T-2 ~> Pa] | |
| 80 | ||
| 81 | type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation | |
| 82 | ||
| 83 | 0 | if (.not. associated(CS)) call MOM_error(FATAL, "set_rho_params: CS not associated") |
| 84 | ||
| 85 | 0 | if (present(min_thickness)) CS%min_thickness = min_thickness |
| 86 | 0 | if (present(integrate_downward_for_e)) CS%integrate_downward_for_e = integrate_downward_for_e |
| 87 | 0 | if (present(interp_CS)) CS%interp_CS = interp_CS |
| 88 | 0 | if (present(ref_pressure)) CS%ref_pressure = ref_pressure |
| 89 | 0 | end subroutine set_rho_params |
| 90 | ||
| 91 | !> Build a rho coordinate column | |
| 92 | !! | |
| 93 | !! 1. Density profiles are calculated on the source grid. | |
| 94 | !! 2. Positions of target densities (for interfaces) are found by interpolation. | |
| 95 | 0 | subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & |
| 96 | z_rigid_top, eta_orig, h_neglect, h_neglect_edge) | |
| 97 | type(rho_CS), intent(in) :: CS !< coord_rho control structure | |
| 98 | integer, intent(in) :: nz !< Number of levels on source grid (i.e. length of h, T, S) | |
| 99 | real, intent(in) :: depth !< Depth of ocean bottom (positive downward) [H ~> m or kg m-2] | |
| 100 | real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] | |
| 101 | real, dimension(nz), intent(in) :: T !< Temperature for source column [C ~> degC] | |
| 102 | real, dimension(nz), intent(in) :: S !< Salinity for source column [S ~> ppt] | |
| 103 | type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure | |
| 104 | real, dimension(CS%nk+1), & | |
| 105 | intent(inout) :: z_interface !< Absolute positions of interfaces [H ~> m or kg m-2] | |
| 106 | real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (positive upward in the same | |
| 107 | !! units as depth) [H ~> m or kg m-2] | |
| 108 | real, optional, intent(in) :: eta_orig !< The actual original height of the top in the same | |
| 109 | !! units as depth) [H ~> m or kg m-2] | |
| 110 | real, intent(in) :: h_neglect !< A negligibly small width for the purpose | |
| 111 | !! of cell reconstructions [H ~> m or kg m-2] | |
| 112 | real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose | |
| 113 | !! of edge value calculations [H ~> m or kg m-2] | |
| 114 | ||
| 115 | ! Local variables | |
| 116 | integer :: k, count_nonzero_layers | |
| 117 | 0 | integer, dimension(nz) :: mapping |
| 118 | 0 | real, dimension(nz) :: pres ! Pressures used to calculate density [R L2 T-2 ~> Pa] |
| 119 | 0 | real, dimension(nz) :: h_nv ! Thicknesses of non-vanishing layers [H ~> m or kg m-2] |
| 120 | 0 | real, dimension(nz) :: densities ! Layer density [R ~> kg m-3] |
| 121 | 0 | real, dimension(nz+1) :: xTmp ! Temporary positions [H ~> m or kg m-2] |
| 122 | 0 | real, dimension(CS%nk) :: h_new ! New thicknesses [H ~> m or kg m-2] |
| 123 | 0 | real, dimension(CS%nk+1) :: x1 ! Interface heights [H ~> m or kg m-2] |
| 124 | ||
| 125 | ! Construct source column with vanished layers removed (stored in h_nv) | |
| 126 | 0 | call copy_finite_thicknesses(nz, h, CS%min_thickness, count_nonzero_layers, h_nv, mapping) |
| 127 | ||
| 128 | 0 | if (count_nonzero_layers > 1) then |
| 129 | 0 | xTmp(1) = 0.0 |
| 130 | 0 | do k = 1,count_nonzero_layers |
| 131 | 0 | xTmp(k+1) = xTmp(k) + h_nv(k) |
| 132 | enddo | |
| 133 | ||
| 134 | ! Compute densities on source column | |
| 135 | 0 | pres(:) = CS%ref_pressure |
| 136 | 0 | call calculate_density(T, S, pres, densities, eqn_of_state) |
| 137 | 0 | do k = 1,count_nonzero_layers |
| 138 | 0 | densities(k) = densities(mapping(k)) |
| 139 | enddo | |
| 140 | ||
| 141 | ! Based on source column density profile, interpolate to generate a new grid | |
| 142 | call build_and_interpolate_grid(CS%interp_CS, densities, count_nonzero_layers, & | |
| 143 | h_nv, xTmp, CS%target_density, CS%nk, h_new, & | |
| 144 | 0 | x1, h_neglect, h_neglect_edge) |
| 145 | ||
| 146 | ! Inflate vanished layers | |
| 147 | 0 | call old_inflate_layers_1d(CS%min_thickness, CS%nk, h_new) |
| 148 | ||
| 149 | ! Comment: The following adjustment of h_new, and re-calculation of h_new via x1 needs to be removed | |
| 150 | 0 | x1(1) = 0.0 ; do k = 1,CS%nk ; x1(k+1) = x1(k) + h_new(k) ; enddo |
| 151 | 0 | do k = 1,CS%nk |
| 152 | 0 | h_new(k) = x1(k+1) - x1(k) |
| 153 | enddo | |
| 154 | ||
| 155 | else ! count_nonzero_layers <= 1 | |
| 156 | 0 | if (nz == CS%nk) then |
| 157 | 0 | h_new(:) = h(:) ! This keeps old behavior |
| 158 | else | |
| 159 | 0 | h_new(:) = 0. |
| 160 | 0 | h_new(1) = h(1) |
| 161 | endif | |
| 162 | endif | |
| 163 | ||
| 164 | ! Return interface positions | |
| 165 | 0 | if (CS%integrate_downward_for_e) then |
| 166 | ! Remapping is defined integrating from zero | |
| 167 | 0 | z_interface(1) = 0. |
| 168 | 0 | do k = 1,CS%nk |
| 169 | 0 | z_interface(k+1) = z_interface(k) - h_new(k) |
| 170 | enddo | |
| 171 | else | |
| 172 | ! The rest of the model defines grids integrating up from the bottom | |
| 173 | 0 | z_interface(CS%nk+1) = -depth |
| 174 | 0 | do k = CS%nk,1,-1 |
| 175 | 0 | z_interface(k) = z_interface(k+1) + h_new(k) |
| 176 | enddo | |
| 177 | endif | |
| 178 | ||
| 179 | 0 | end subroutine build_rho_column |
| 180 | ||
| 181 | !### build_rho_column_iteratively is never used or called. | |
| 182 | ||
| 183 | !> Iteratively build a rho coordinate column | |
| 184 | !! | |
| 185 | !! The algorithm operates as follows within each column: | |
| 186 | !! | |
| 187 | !! 1. Given T & S within each layer, the layer densities are computed. | |
| 188 | !! 2. Based on these layer densities, a global density profile is reconstructed | |
| 189 | !! (this profile is monotonically increasing and may be discontinuous) | |
| 190 | !! 3. The new grid interfaces are determined based on the target interface | |
| 191 | !! densities. | |
| 192 | !! 4. T & S are remapped onto the new grid. | |
| 193 | !! 5. Return to step 1 until convergence or until the maximum number of | |
| 194 | !! iterations is reached, whichever comes first. | |
| 195 | 0 | subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_state, & |
| 196 | 0 | zInterface, h_neglect, h_neglect_edge, dev_tol) |
| 197 | type(rho_CS), intent(in) :: CS !< Regridding control structure | |
| 198 | type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options | |
| 199 | integer, intent(in) :: nz !< Number of levels | |
| 200 | real, intent(in) :: depth !< Depth of ocean bottom [Z ~> m] | |
| 201 | real, dimension(nz), intent(in) :: h !< Layer thicknesses in Z coordinates [Z ~> m] | |
| 202 | real, dimension(nz), intent(in) :: T !< T for column [C ~> degC] | |
| 203 | real, dimension(nz), intent(in) :: S !< S for column [S ~> ppt] | |
| 204 | type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure | |
| 205 | real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces [Z ~> m] | |
| 206 | real, intent(in) :: h_neglect !< A negligibly small width for the | |
| 207 | !! purpose of cell reconstructions | |
| 208 | !! in the same units as h [Z ~> m] | |
| 209 | real, optional, intent(in) :: h_neglect_edge !< A negligibly small width | |
| 210 | !! for the purpose of edge value calculations | |
| 211 | !! in the same units as h [Z ~> m] | |
| 212 | real, optional, intent(in) :: dev_tol !< The tolerance for the deviation between | |
| 213 | !! successive grids for determining when the | |
| 214 | !! iterative solver has converged [Z ~> m] | |
| 215 | ||
| 216 | ! Local variables | |
| 217 | 0 | real, dimension(nz+1) :: x0, x1, xTmp ! Temporary interface heights [Z ~> m] |
| 218 | 0 | real, dimension(nz) :: pres ! The pressure used in the equation of state [R L2 T-2 ~> Pa]. |
| 219 | 0 | real, dimension(nz) :: densities ! Layer densities [R ~> kg m-3] |
| 220 | 0 | real, dimension(nz) :: T_tmp, S_tmp ! A temporary profile of temperature [C ~> degC] and salinity [S ~> ppt]. |
| 221 | 0 | real, dimension(nz) :: h0, h1, hTmp ! Temporary thicknesses [Z ~> m] |
| 222 | real :: deviation ! When iterating to determine the final grid, this is the | |
| 223 | ! deviation between two successive grids [Z ~> m]. | |
| 224 | real :: deviation_tol ! Deviation tolerance between succesive grids in | |
| 225 | ! regridding iterations [Z ~> m] | |
| 226 | real :: threshold ! The minimum thickness for a layer to be considered to exist [Z ~> m] | |
| 227 | 0 | integer, dimension(nz) :: mapping ! The indices of the massive layers in the initial column. |
| 228 | integer :: k, m, count_nonzero_layers | |
| 229 | ||
| 230 | ! Maximum number of regridding iterations | |
| 231 | integer, parameter :: NB_REGRIDDING_ITERATIONS = 1 | |
| 232 | ||
| 233 | 0 | threshold = CS%min_thickness |
| 234 | 0 | pres(:) = CS%ref_pressure |
| 235 | 0 | T_tmp(:) = T(:) |
| 236 | 0 | S_tmp(:) = S(:) |
| 237 | 0 | h0(:) = h(:) |
| 238 | ||
| 239 | ! Start iterations to build grid | |
| 240 | 0 | m = 1 |
| 241 | 0 | deviation_tol = 1.0e-15*depth ; if (present(dev_tol)) deviation_tol = dev_tol |
| 242 | ||
| 243 | 0 | do m=1,NB_REGRIDDING_ITERATIONS |
| 244 | ||
| 245 | ! Construct column with vanished layers removed | |
| 246 | 0 | call copy_finite_thicknesses(nz, h0, threshold, count_nonzero_layers, hTmp, mapping) |
| 247 | 0 | if ( count_nonzero_layers <= 1 ) then |
| 248 | 0 | h1(:) = h0(:) |
| 249 | 0 | exit ! stop iterations here |
| 250 | endif | |
| 251 | ||
| 252 | 0 | xTmp(1) = 0.0 |
| 253 | 0 | do k = 1,count_nonzero_layers |
| 254 | 0 | xTmp(k+1) = xTmp(k) + hTmp(k) |
| 255 | enddo | |
| 256 | ||
| 257 | ! Compute densities within current water column | |
| 258 | 0 | call calculate_density(T_tmp, S_tmp, pres, densities, eqn_of_state) |
| 259 | ||
| 260 | 0 | do k = 1,count_nonzero_layers |
| 261 | 0 | densities(k) = densities(mapping(k)) |
| 262 | enddo | |
| 263 | ||
| 264 | ! One regridding iteration | |
| 265 | ! Based on global density profile, interpolate to generate a new grid | |
| 266 | call build_and_interpolate_grid(CS%interp_CS, densities, count_nonzero_layers, & | |
| 267 | 0 | hTmp, xTmp, CS%target_density, nz, h1, x1, h_neglect, h_neglect_edge) |
| 268 | ||
| 269 | 0 | call old_inflate_layers_1d( CS%min_thickness, nz, h1 ) |
| 270 | 0 | x1(1) = 0.0 ; do k = 1,nz ; x1(k+1) = x1(k) + h1(k) ; enddo |
| 271 | ||
| 272 | ! Remap T and S from previous grid to new grid | |
| 273 | 0 | do k = 1,nz |
| 274 | 0 | h1(k) = x1(k+1) - x1(k) |
| 275 | enddo | |
| 276 | ||
| 277 | 0 | call remapping_core_h(remapCS, nz, h0, S, nz, h1, S_tmp) |
| 278 | ||
| 279 | 0 | call remapping_core_h(remapCS, nz, h0, T, nz, h1, T_tmp) |
| 280 | ||
| 281 | ! Compute the deviation between two successive grids | |
| 282 | 0 | deviation = 0.0 |
| 283 | 0 | x0(1) = 0.0 |
| 284 | 0 | x1(1) = 0.0 |
| 285 | 0 | do k = 2,nz |
| 286 | 0 | x0(k) = x0(k-1) + h0(k-1) |
| 287 | 0 | x1(k) = x1(k-1) + h1(k-1) |
| 288 | 0 | deviation = deviation + (x0(k)-x1(k))**2 |
| 289 | enddo | |
| 290 | 0 | deviation = sqrt( deviation / (nz-1) ) |
| 291 | ||
| 292 | 0 | if ( deviation <= deviation_tol ) exit |
| 293 | ||
| 294 | ! Copy final grid onto start grid for next iteration | |
| 295 | 0 | h0(:) = h1(:) |
| 296 | enddo ! end regridding iterations | |
| 297 | ||
| 298 | 0 | if (CS%integrate_downward_for_e) then |
| 299 | 0 | zInterface(1) = 0. |
| 300 | 0 | do k = 1,nz |
| 301 | 0 | zInterface(k+1) = zInterface(k) - h1(k) |
| 302 | ! Adjust interface position to accommodate inflating layers | |
| 303 | ! without disturbing the interface above | |
| 304 | enddo | |
| 305 | else | |
| 306 | ! The rest of the model defines grids integrating up from the bottom | |
| 307 | 0 | zInterface(nz+1) = -depth |
| 308 | 0 | do k = nz,1,-1 |
| 309 | 0 | zInterface(k) = zInterface(k+1) + h1(k) |
| 310 | ! Adjust interface position to accommodate inflating layers | |
| 311 | ! without disturbing the interface above | |
| 312 | enddo | |
| 313 | endif | |
| 314 | ||
| 315 | 0 | end subroutine build_rho_column_iteratively |
| 316 | ||
| 317 | !> Copy column thicknesses with vanished layers removed | |
| 318 | 0 | subroutine copy_finite_thicknesses(nk, h_in, thresh, nout, h_out, mapping) |
| 319 | integer, intent(in) :: nk !< Number of layer for h_in, T_in, S_in | |
| 320 | real, dimension(nk), intent(in) :: h_in !< Thickness of input column [H ~> m or kg m-2] or [Z ~> m] | |
| 321 | real, intent(in) :: thresh !< Thickness threshold defining vanished | |
| 322 | !! layers [H ~> m or kg m-2] or [Z ~> m] | |
| 323 | integer, intent(out) :: nout !< Number of non-vanished layers | |
| 324 | real, dimension(nk), intent(out) :: h_out !< Thickness of output column [H ~> m or kg m-2] or [Z ~> m] | |
| 325 | integer, dimension(nk), intent(out) :: mapping !< Index of k-out corresponding to k-in | |
| 326 | ! Local variables | |
| 327 | integer :: k, k_thickest | |
| 328 | real :: thickness_in_vanished ! Summed thicknesses in discarded layers [H ~> m or kg m-2] or [Z ~> m] | |
| 329 | real :: thickest_h_out ! Thickness of the thickest layer [H ~> m or kg m-2] or [Z ~> m] | |
| 330 | ||
| 331 | ! Build up new grid | |
| 332 | 0 | nout = 0 |
| 333 | 0 | thickness_in_vanished = 0.0 |
| 334 | 0 | thickest_h_out = h_in(1) |
| 335 | 0 | k_thickest = 1 |
| 336 | 0 | do k = 1, nk |
| 337 | 0 | mapping(k) = nout ! Note k>=nout always |
| 338 | 0 | h_out(k) = 0. ! Make sure h_out is set everywhere |
| 339 | 0 | if (h_in(k) > thresh) then |
| 340 | ! For non-vanished layers | |
| 341 | 0 | nout = nout + 1 |
| 342 | 0 | mapping(nout) = k |
| 343 | 0 | h_out(nout) = h_in(k) |
| 344 | 0 | if (h_out(nout) > thickest_h_out) then |
| 345 | 0 | thickest_h_out = h_out(nout) |
| 346 | 0 | k_thickest = nout |
| 347 | endif | |
| 348 | else | |
| 349 | ! Add up mass in vanished layers | |
| 350 | 0 | thickness_in_vanished = thickness_in_vanished + h_in(k) |
| 351 | endif | |
| 352 | enddo | |
| 353 | ||
| 354 | ! No finite layers | |
| 355 | 0 | if (nout <= 1) return |
| 356 | ||
| 357 | ! Adjust for any lost volume in vanished layers | |
| 358 | 0 | h_out(k_thickest) = h_out(k_thickest) + thickness_in_vanished |
| 359 | ||
| 360 | end subroutine copy_finite_thicknesses | |
| 361 | ||
| 362 | !------------------------------------------------------------------------------ | |
| 363 | !> Inflate vanished layers to finite (nonzero) width | |
| 364 | 7564 | subroutine old_inflate_layers_1d( min_thickness, nk, h ) |
| 365 | ||
| 366 | ! Argument | |
| 367 | real, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] or other units | |
| 368 | integer, intent(in) :: nk !< Number of layers in the grid | |
| 369 | real, dimension(:), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] or other units | |
| 370 | ||
| 371 | ! Local variable | |
| 372 | integer :: k | |
| 373 | integer :: k_found | |
| 374 | integer :: count_nonzero_layers | |
| 375 | real :: delta ! An increase to a layer to increase it to the minimum thickness in the | |
| 376 | ! same units as h, often [H ~> m or kg m-2] | |
| 377 | real :: correction ! The accumulated correction that will be applied to the thickest layer | |
| 378 | ! to give mass conservation in the same units as h, often [H ~> m or kg m-2] | |
| 379 | real :: maxThickness ! The thickness of the thickest layer in the same units as h, often [H ~> m or kg m-2] | |
| 380 | ||
| 381 | ! Count number of nonzero layers | |
| 382 | 7564 | count_nonzero_layers = 0 |
| 383 | 574864 | do k = 1,nk |
| 384 | 574864 | if ( h(k) > min_thickness ) then |
| 385 | 186766 | count_nonzero_layers = count_nonzero_layers + 1 |
| 386 | endif | |
| 387 | enddo | |
| 388 | ||
| 389 | ! If all layer thicknesses are greater than the threshold, exit routine | |
| 390 | 7564 | if ( count_nonzero_layers == nk ) return |
| 391 | ||
| 392 | ! If all thicknesses are zero, inflate them all and exit | |
| 393 | 7548 | if ( count_nonzero_layers == 0 ) then |
| 394 | 18544 | do k = 1,nk |
| 395 | 18544 | h(k) = min_thickness |
| 396 | enddo | |
| 397 | 244 | return |
| 398 | endif | |
| 399 | ||
| 400 | ! Inflate zero layers | |
| 401 | 7304 | correction = 0.0 |
| 402 | 555104 | do k = 1,nk |
| 403 | 555104 | if ( h(k) <= min_thickness ) then |
| 404 | 362234 | delta = min_thickness - h(k) |
| 405 | 362234 | correction = correction + delta |
| 406 | 362234 | h(k) = h(k) + delta |
| 407 | endif | |
| 408 | enddo | |
| 409 | ||
| 410 | ! Modify thicknesses of nonzero layers to ensure volume conservation | |
| 411 | 7304 | maxThickness = h(1) |
| 412 | 7304 | k_found = 1 |
| 413 | 555104 | do k = 1,nk |
| 414 | 555104 | if ( h(k) > maxThickness ) then |
| 415 | 14402 | maxThickness = h(k) |
| 416 | 14402 | k_found = k |
| 417 | endif | |
| 418 | enddo | |
| 419 | ||
| 420 | 7304 | h(k_found) = h(k_found) - correction |
| 421 | ||
| 422 | end subroutine old_inflate_layers_1d | |
| 423 | ||
| 424 | 0 | end module coord_rho |