[6] | 1 | SUBROUTINE ice_bio_remap(nlay_s,nlay_i,kideb,kiut) |
---|
| 2 | !-----------------------------------------------------------------------------! |
---|
| 3 | INCLUDE 'type.com' |
---|
| 4 | INCLUDE 'para.com' |
---|
| 5 | INCLUDE 'const.com' |
---|
| 6 | INCLUDE 'ice.com' |
---|
| 7 | INCLUDE 'thermo.com' |
---|
| 8 | INCLUDE 'bio.com' |
---|
| 9 | |
---|
| 10 | REAL(8), DIMENSION( 0:maxnlay+2 ) :: |
---|
| 11 | & z0 |
---|
| 12 | |
---|
| 13 | REAL(8), DIMENSION( maxnlay + 2 ) :: |
---|
| 14 | & zq0 , ! : scalar content on the physical grid (input) |
---|
| 15 | & zthick0 ! : thickness of biological layers |
---|
| 16 | |
---|
| 17 | REAL(8), DIMENSION( maxnlay ) :: |
---|
| 18 | & zq1 , ! : scalar content on the biological grid (output) |
---|
| 19 | & zdeltaz |
---|
| 20 | |
---|
| 21 | REAL(8), DIMENSION( nlay_bio , maxnlay ) :: |
---|
| 22 | & zweight ! : relayering matrix |
---|
| 23 | |
---|
| 24 | INTEGER :: zcase |
---|
| 25 | zeps = 1.0e-20 |
---|
| 26 | |
---|
| 27 | !==============================================================================! |
---|
| 28 | |
---|
| 29 | WRITE(numout,*) |
---|
| 30 | WRITE(numout,*) ' ice_bio_remap : ' |
---|
| 31 | WRITE(numout,*) ' ~~~~~~~~~~~~~~~ ' |
---|
| 32 | WRITE(numout,*) |
---|
| 33 | WRITE(numout,*) ' *** Before remapping *** ' |
---|
| 34 | DO jn = 1, ntra_bio |
---|
| 35 | IF ( flag_active(jn) ) THEN |
---|
| 36 | WRITE(numout,*) ' biotr_i_nam : ', biotr_i_nam(jn) |
---|
| 37 | WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn, jk), jk = 1, |
---|
| 38 | & nlay_bio ) |
---|
| 39 | ENDIF |
---|
| 40 | END DO |
---|
| 41 | |
---|
| 42 | !-------------------- |
---|
| 43 | ! Conservation check |
---|
| 44 | !-------------------- |
---|
| 45 | CALL ice_bio_column(kideb,kiut,ntra_bio,mt_i_bio_init,cbu_i_bio, |
---|
| 46 | & deltaz_i_bio, .FALSE.) |
---|
| 47 | |
---|
| 48 | DO ji = kideb, kiut |
---|
| 49 | WRITE(numout,*) |
---|
| 50 | WRITE(numout,*) ' Inputs : ' |
---|
| 51 | WRITE(numout,*) ' ~~~~~~ ' |
---|
| 52 | WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) |
---|
| 53 | WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) |
---|
| 54 | WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) |
---|
| 55 | ! |
---|
| 56 | !------------------------------------------------------------------------------| |
---|
| 57 | ! 1) Switches | |
---|
| 58 | !------------------------------------------------------------------------------| |
---|
| 59 | ! |
---|
| 60 | WRITE(numout,*) |
---|
| 61 | WRITE(numout,*) ' Switches : ' |
---|
| 62 | WRITE(numout,*) ' ~~~~~~~~ ' |
---|
| 63 | |
---|
| 64 | !---------------------------------- |
---|
| 65 | ! Biological Grid Type |
---|
| 66 | !---------------------------------- |
---|
| 67 | IF ( ( c_grid .NE. 'SL' ) .AND. ( c_grid .NE. 'BA' ) ) THEN |
---|
| 68 | zcase = 1 ! ML / DL cases |
---|
| 69 | ELSE |
---|
| 70 | zcase = 2 ! SL / BA cases |
---|
| 71 | ENDIF |
---|
| 72 | |
---|
| 73 | !---------------------------------- |
---|
| 74 | ! Surface melt indicator : icsuind |
---|
| 75 | !---------------------------------- |
---|
| 76 | ! ice surface behaviour : computation of icsuind-icsuswi |
---|
| 77 | ! icsuind : index which values equals |
---|
| 78 | ! 0 if there is nothing |
---|
| 79 | ! 1 if first layer has started to melt |
---|
| 80 | ! 2 if first and second layer have started ... |
---|
| 81 | ! etc ... |
---|
| 82 | icsuind = 0 |
---|
| 83 | deltah = 0.0 |
---|
| 84 | DO layer = 1, nlay_bio |
---|
| 85 | IF ( - dh_i_surf(ji) .GT. deltah ) THEN |
---|
| 86 | icsuind = layer |
---|
| 87 | ENDIF |
---|
| 88 | deltah = deltah + deltaz_i_bio(layer) |
---|
| 89 | END DO |
---|
| 90 | |
---|
| 91 | !------------------------------- |
---|
| 92 | ! Surface melt switch : icsuswi |
---|
| 93 | !------------------------------- |
---|
| 94 | ! icsuswi : switch which value equals 1 if ice melts at the surface |
---|
| 95 | ! 0 if not |
---|
| 96 | icsuswi = MAX( 0 , INT( - dh_i_surf(ji) |
---|
| 97 | & / MAX ( zeps , ABS( dh_i_surf(ji) ) ) ) ) |
---|
| 98 | |
---|
| 99 | !-------------------------------- |
---|
| 100 | ! Ice bottom indicator : icboind |
---|
| 101 | !-------------------------------- |
---|
| 102 | ! icboind : index which values equals 0 if accretion is on the way |
---|
| 103 | ! 1 if last layer has started to melt |
---|
| 104 | ! 2 if penultiem layer has started ... |
---|
| 105 | ! etc ... |
---|
| 106 | icboind = 0 |
---|
| 107 | deltah = 0.0 |
---|
| 108 | DO layer = nlay_bio, 1, -1 |
---|
| 109 | IF ( - dh_i_bott(ji) .GT. deltah ) THEN |
---|
| 110 | icboind = nlay_bio + 1 - layer |
---|
| 111 | ENDIF |
---|
| 112 | deltah = deltah + deltaz_i_bio(layer) |
---|
| 113 | END DO |
---|
| 114 | |
---|
| 115 | !----------------------------- |
---|
| 116 | ! Ice bottom switch : icboswi |
---|
| 117 | !----------------------------- |
---|
| 118 | ! icboswi : switch which value equals 1 if accretion of ice is on the way |
---|
| 119 | ! 0 if ablation is on the way |
---|
| 120 | icboswi = MAX( 0 , INT( dh_i_bott(ji) |
---|
| 121 | & / MAX( zeps , ABS( dh_i_bott(ji) ) ) ) ) |
---|
| 122 | |
---|
| 123 | !------------------------------ |
---|
| 124 | ! Snow ice indicator : snicind |
---|
| 125 | !------------------------------ |
---|
| 126 | ! snow-ice formation : calcul de snicind-snicswi |
---|
| 127 | ! snicind : index which values equals 0 if no snow-ice forms |
---|
| 128 | ! 1 if last layer of snow has started to melt |
---|
| 129 | ! 2 if penultiem layer ... |
---|
| 130 | snicind = 0 |
---|
| 131 | deltah = 0.0 |
---|
| 132 | DO layer = nlay_s, 1, -1 |
---|
| 133 | IF ( dh_snowice(ji) .GT. deltah) THEN |
---|
| 134 | snicind = nlay_s+1-layer |
---|
| 135 | ENDIF |
---|
| 136 | deltah = deltah + h_s(layer) |
---|
| 137 | END DO |
---|
| 138 | |
---|
| 139 | !--------------------------- |
---|
| 140 | ! Snow ice switch : snicswi |
---|
| 141 | !--------------------------- |
---|
| 142 | ! snicswi : switch which value equals 1 if snow-ice forms |
---|
| 143 | ! 0 if not |
---|
| 144 | snicswi = MAX( 0 , INT( dh_snowice(ji) / |
---|
| 145 | & MAX( zeps , ABS( dh_snowice(ji) ) ) ) ) |
---|
| 146 | |
---|
| 147 | WRITE(numout,*) ' icsuind : ', icsuind |
---|
| 148 | WRITE(numout,*) ' icsuswi : ', icsuswi |
---|
| 149 | WRITE(numout,*) ' icboind : ', icboind |
---|
| 150 | WRITE(numout,*) ' icboswi : ', icboswi |
---|
| 151 | WRITE(numout,*) ' snicind : ', snicind |
---|
| 152 | WRITE(numout,*) ' snicswi : ', snicswi |
---|
| 153 | WRITE(numout,*) |
---|
| 154 | ! |
---|
| 155 | !------------------------------------------------------------------------------| |
---|
| 156 | ! 2) Tracer sources |
---|
| 157 | !------------------------------------------------------------------------------| |
---|
| 158 | ! |
---|
| 159 | WRITE(numout,*) ' Tracer sources : ' |
---|
| 160 | WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' |
---|
| 161 | |
---|
| 162 | DO jn = 1, ntra_bio |
---|
| 163 | |
---|
| 164 | IF ( flag_active (jn) ) THEN |
---|
| 165 | |
---|
| 166 | c_s_bio(jn) = 0.0 ! now no concentration in the snow |
---|
| 167 | ch_bo_bio(jn) = 0.0 |
---|
| 168 | ch_si_bio(jn) = 0.0 |
---|
| 169 | |
---|
| 170 | IF ( ln_trbo ) |
---|
[27] | 171 | & ch_bo_bio(jn) = rn_e_newice * c_w_bio(jn) * |
---|
| 172 | & MAX( dh_i_bott(ji), 0.0 ) |
---|
[6] | 173 | |
---|
| 174 | IF ( ln_trsi ) |
---|
| 175 | & ch_si_bio(jn) = ( ( rhog - rhon ) / rhog * c_w_bio(jn) |
---|
| 176 | & + ( rhon / rhog ) * c_s_bio(jn) ) * |
---|
| 177 | & MAX( dh_snowice(ji) , 0.0 ) |
---|
| 178 | |
---|
| 179 | fcbp(jn) = ch_bo_bio(jn) / ddtb |
---|
| 180 | fcsi(jn) = ch_si_bio(jn) / ddtb |
---|
| 181 | |
---|
| 182 | WRITE(numout,*) ' Tracer : ', biotr_i_nam(jn) |
---|
| 183 | WRITE(numout,*) ' ch_bo_bio : ', ch_bo_bio(jn) |
---|
| 184 | WRITE(numout,*) ' ch_si_bio : ', ch_si_bio(jn) |
---|
| 185 | ! WRITE(numout,*) ' c_s_bio : ', c_s_bio (jn) |
---|
| 186 | ! WRITE(numout,*) ' c_w_bio: ', c_w_bio(jn) |
---|
| 187 | ! WRITE(numout,*) ' c_ws_i : ', |
---|
| 188 | ! & ( rhog - rhon ) / rhog * c_w_bio(jn) |
---|
| 189 | |
---|
| 190 | ENDIF |
---|
| 191 | |
---|
| 192 | END DO !jn |
---|
| 193 | ! |
---|
| 194 | !------------------------------------------------------------------------------| |
---|
| 195 | ! 3) Compute new concentrations by remapping tracers |
---|
| 196 | !------------------------------------------------------------------------------| |
---|
| 197 | ! |
---|
| 198 | SELECT CASE (zcase) |
---|
| 199 | |
---|
| 200 | !========================! |
---|
| 201 | CASE (1) !=== MULTI-LAYER CASE ===! |
---|
| 202 | !========================! |
---|
| 203 | |
---|
| 204 | ! |
---|
| 205 | !------------------------------------------------------------------------| |
---|
| 206 | ! 3.1) Old grid: zthick0, z0, zdeltaz |
---|
| 207 | !------------------------------------------------------------------------| |
---|
| 208 | ! |
---|
| 209 | WRITE(numout,*) ' Old grid : ' |
---|
| 210 | WRITE(numout,*) ' ~~~~~~~~~~ ' |
---|
| 211 | |
---|
| 212 | !--- Diffusive remapping, compute z0 and zthick0 ---! |
---|
| 213 | ! |
---|
| 214 | ! indexes of the vectors |
---|
| 215 | ntop0 = 1 |
---|
| 216 | nbot0 = nlay_bio + 1 - icboind + (1 - icsuind) * icsuswi + |
---|
| 217 | & snicswi |
---|
| 218 | nbot0 = MAX(1, MIN( nlay_bio + 1 - icboind + |
---|
| 219 | & (1-icsuind)*icsuswi |
---|
| 220 | & + snicswi, nlay_bio + 2 ) ) |
---|
| 221 | |
---|
| 222 | WRITE(numout,*) ' ntop0 : ', ntop0 |
---|
| 223 | WRITE(numout,*) ' nbot0 : ', nbot0 |
---|
| 224 | |
---|
| 225 | ! Cotes of the top of the layers |
---|
| 226 | z0(0) = 0.0 |
---|
| 227 | DO layer = 1, nbot0-1 |
---|
| 228 | limsum = ( (icsuswi * (icsuind+layer-1) + |
---|
| 229 | & (1-icsuswi)*layer) ) * |
---|
| 230 | & (1-snicswi) + (layer-1)*snicswi |
---|
| 231 | z0(layer) = icsuswi*dh_i_surf(ji) + snicswi*dh_snowice(ji) |
---|
| 232 | DO layer_a = 1, limsum |
---|
| 233 | z0(layer) = z0(layer) + deltaz_i_bio(layer_a) |
---|
| 234 | END DO |
---|
| 235 | END DO |
---|
| 236 | |
---|
| 237 | z0(nbot0) = icsuswi*dh_i_surf(ji) + snicswi*dh_snowice(ji) + |
---|
| 238 | & dh_i_bott(ji) |
---|
| 239 | |
---|
| 240 | DO layer = 1, nlay_bio |
---|
| 241 | z0(nbot0) = z0(nbot0) + deltaz_i_bio(layer) |
---|
| 242 | END DO |
---|
| 243 | |
---|
| 244 | z0(1) = snicswi * dh_snowice(ji) + (1 - snicswi) * z0(1) |
---|
| 245 | |
---|
| 246 | DO layer = ntop0, nbot0 |
---|
| 247 | zthick0(layer) = z0(layer) - z0(layer-1) |
---|
| 248 | END DO |
---|
| 249 | |
---|
| 250 | WRITE(numout,*) ' Old grid, ntop0 : ', ntop0, ' nbot0 : ', nbot0 |
---|
| 251 | WRITE(numout,*) ' z0 : ', ( z0(layer), layer = 0, nbot0 ) |
---|
| 252 | WRITE(numout,*) ' zthick0 : ', ( zthick0(layer) , |
---|
| 253 | & layer = 1, nbot0 ) |
---|
| 254 | WRITE(numout,*) |
---|
| 255 | |
---|
| 256 | !--- Squeezing remapping, compute zdeltaz ---!' |
---|
| 257 | ! |
---|
| 258 | zdeltaz(1:nlay_bio) = deltaz_i_bio(:) |
---|
| 259 | |
---|
| 260 | ! |
---|
| 261 | !-------------------------------------------------------------------------| |
---|
| 262 | ! 3.2) New grid |
---|
| 263 | !-------------------------------------------------------------------------| |
---|
| 264 | ! |
---|
| 265 | WRITE(numout,*) ' New grid : ' |
---|
| 266 | WRITE(numout,*) ' ~~~~~~~~~~ ' |
---|
| 267 | ! indexes of the vectors |
---|
| 268 | ntop1 = 1 |
---|
| 269 | nbot1 = nlay_bio |
---|
| 270 | ! cotes and thicknesses |
---|
| 271 | CALL ice_bio_grid(kideb,kiut,nlay_i,.TRUE.) ! compute the biological grid |
---|
| 272 | |
---|
| 273 | WRITE(numout,*) ' New grid, ntop1 : ', ntop1, ' nbot1 : ', nbot1 |
---|
| 274 | WRITE(numout,*) ' zb_i_bio: ', ( zb_i_bio(layer), |
---|
| 275 | & layer = 0, nbot1 ) |
---|
| 276 | ! |
---|
| 277 | !------------------------------------------------------------------------| |
---|
| 278 | ! 3.3) Weights (diffusive remapping only) |
---|
| 279 | !------------------------------------------------------------------------| |
---|
| 280 | ! |
---|
| 281 | WRITE(numout,*) |
---|
| 282 | WRITE(numout,*) ' Weights : ' |
---|
| 283 | WRITE(numout,*) ' ~~~~~~~~~~ ' |
---|
| 284 | |
---|
| 285 | DO layer1 = 1, nlay_bio |
---|
| 286 | DO layer0 = 1, nbot0 |
---|
| 287 | zweight(layer1,layer0) = MAX ( 0.0 , ( MIN ( z0(layer0) , |
---|
| 288 | & zb_i_bio(layer1) ) |
---|
| 289 | & - MAX ( z0 (layer0-1) , zb_i_bio(layer1-1) ) ) / |
---|
| 290 | & zthick0(layer0) ) |
---|
| 291 | ! WRITE(numout,*) ' layer0, layer1 : ', layer0, layer1 |
---|
| 292 | ! WRITE(numout,*) ' zweight : ', zweight(layer1,layer0) |
---|
| 293 | END DO |
---|
| 294 | END DO |
---|
| 295 | WRITE(numout,*) |
---|
| 296 | |
---|
| 297 | ! |
---|
| 298 | !------------------------------------------------------------------------| |
---|
| 299 | ! 3.4) Tracer remapping |
---|
| 300 | !------------------------------------------------------------------------| |
---|
| 301 | ! |
---|
| 302 | WRITE(numout,*) ' Tracer remapping : ' |
---|
| 303 | WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' |
---|
| 304 | |
---|
| 305 | DO jn = 1, ntra_bio |
---|
| 306 | |
---|
| 307 | IF ( flag_active (jn) ) THEN |
---|
| 308 | |
---|
| 309 | WRITE(numout,*) ' ------------------------------------------' |
---|
| 310 | WRITE(numout,*) ' Tracer : ', biotr_i_nam(jn) |
---|
| 311 | WRITE(numout,*) ' Remapping type nn_remp : ', nn_remp(jn) |
---|
| 312 | WRITE(numout,*) ' ------------------------------------------' |
---|
| 313 | WRITE(numout,*) |
---|
| 314 | |
---|
| 315 | !--------------------------------------------------------------------! |
---|
| 316 | ! 3.4.1) Compute 'new' tracer contents |
---|
| 317 | !--------------------------------------------------------------------! |
---|
| 318 | |
---|
| 319 | !=====================! |
---|
| 320 | IF ( nn_remp(jn) .EQ. 1 ) THEN ! Diffusive remapping ! |
---|
| 321 | !=====================! |
---|
| 322 | !--------------------! |
---|
| 323 | ! Old tracer content ! |
---|
| 324 | !--------------------! |
---|
| 325 | |
---|
| 326 | WRITE(numout,*) ' Tracer content ...' |
---|
| 327 | WRITE(numout,*) |
---|
| 328 | |
---|
| 329 | !--- Inner layers ---! |
---|
| 330 | mt_i_bio_init(jn) = 0.0 |
---|
| 331 | |
---|
| 332 | DO layer = ntop0, nbot0 |
---|
| 333 | limsum = MAX(1,MIN(snicswi*(layer-1) + icsuswi*(layer-1 |
---|
| 334 | & + icsuind) |
---|
| 335 | & + (1-icsuswi)*(1-snicswi)*layer, nlay_bio)) |
---|
| 336 | zq0(layer) = zthick0(layer) * cbu_i_bio(jn,limsum) |
---|
| 337 | |
---|
| 338 | ! WRITE(numout,*) ' limsum : ', limsum |
---|
| 339 | ! IF ( limsum .GE. 1 ) |
---|
| 340 | ! & WRITE(numout,*) ' cbu_i_bio: ', cbu_i_bio(jn,limsum) |
---|
| 341 | |
---|
| 342 | ! WRITE(numout,*) ' zq0 : ', zq0(layer) |
---|
| 343 | ! WRITE(numout,*) ' zthick0: ', zthick0(layer) |
---|
| 344 | |
---|
| 345 | END DO |
---|
| 346 | |
---|
| 347 | !--- Bottom layer ---! |
---|
| 348 | ! bottom layer if ice forms at the bottom |
---|
| 349 | zq0(nbot0) = ( 1 - icboswi ) * zq0(nbot0) + icboswi * |
---|
| 350 | & ch_bo_bio(jn) |
---|
| 351 | |
---|
| 352 | !--- Upper layer ---! |
---|
| 353 | ! first layer if snow ice forms |
---|
| 354 | zq0(1) = snicswi * ch_si_bio(jn) |
---|
| 355 | & + ( 1 - snicswi ) * zq0(1) |
---|
| 356 | |
---|
| 357 | ! WRITE(numout,*) ' snicswi : ', snicswi |
---|
| 358 | ! WRITE(numout,*) ' c_si_bio : ', ch_si_bio(jn) / zthick0(1) |
---|
| 359 | |
---|
| 360 | DO layer = ntop0, nbot0 |
---|
| 361 | mt_i_bio_init(jn) = mt_i_bio_init(jn) + |
---|
| 362 | & zq0(layer) |
---|
| 363 | END DO |
---|
| 364 | |
---|
| 365 | WRITE(numout,*) ' zq0 : ', ( zq0(layer), |
---|
| 366 | & layer = 1, nbot0 ) |
---|
| 367 | !----------------! |
---|
| 368 | ! Remapping ! |
---|
| 369 | !----------------! |
---|
| 370 | |
---|
| 371 | WRITE(numout,*) ' Remapping ... ' |
---|
| 372 | WRITE(numout,*) |
---|
| 373 | |
---|
| 374 | DO layer1 = 1, nlay_bio |
---|
| 375 | zq1(layer1) = 0.0 |
---|
| 376 | DO layer0 = 1, nbot0 |
---|
| 377 | zq1(layer1) = zq1(layer1) + zweight(layer1,layer0) * |
---|
| 378 | & zq0(layer0) |
---|
| 379 | END DO |
---|
| 380 | END DO |
---|
| 381 | |
---|
| 382 | ENDIF ! nn_remp |
---|
| 383 | |
---|
| 384 | !=====================! |
---|
| 385 | IF ( nn_remp(jn) .EQ. 2 ) THEN ! Squeezing remapping |
---|
| 386 | !=====================! |
---|
| 387 | |
---|
| 388 | WRITE(numout,*) ' Remapping ... ' |
---|
| 389 | WRITE(numout,*) |
---|
| 390 | |
---|
| 391 | |
---|
| 392 | ! Inner layers |
---|
| 393 | DO layer = 1, nlay_bio |
---|
| 394 | zq0(layer) = zdeltaz(layer) * cbu_i_bio(jn,layer) |
---|
| 395 | END DO |
---|
| 396 | |
---|
| 397 | ! Surface layer |
---|
| 398 | zq0(1) = zq0(1) + ch_si_bio(jn) |
---|
| 399 | |
---|
| 400 | ! Bottom layer |
---|
| 401 | zq0(nlay_bio) = zq0(nlay_bio) + ch_bo_bio(jn) |
---|
| 402 | |
---|
| 403 | ! Tracer content for conservation check |
---|
| 404 | mt_i_bio_init(jn) = 0.0 |
---|
| 405 | DO layer = 1, nlay_bio |
---|
| 406 | mt_i_bio_init(jn) = mt_i_bio_init(jn) + |
---|
| 407 | & zq0(layer) |
---|
| 408 | END DO |
---|
| 409 | |
---|
| 410 | zq1(1:nlay_bio) = zq0(1:nlay_bio) |
---|
| 411 | |
---|
| 412 | ENDIF ! nn_remp |
---|
| 413 | |
---|
| 414 | WRITE(numout,*) |
---|
| 415 | WRITE(numout,*) ' zq1 : ', ( zq1(layer), |
---|
| 416 | & layer = 1, nlay_bio ) |
---|
| 417 | WRITE(numout,*) |
---|
| 418 | |
---|
| 419 | !--------------------------------------------------------------------! |
---|
| 420 | ! 3.4.2) Retrieve bulk concentration from content |
---|
| 421 | !--------------------------------------------------------------------! |
---|
| 422 | ! |
---|
| 423 | DO layer = 1, nlay_bio |
---|
| 424 | cbu_i_bio(jn,layer) = zq1(layer) / deltaz_i_bio(layer) |
---|
| 425 | END DO ! layer |
---|
| 426 | |
---|
| 427 | ENDIF ! flag_active |
---|
| 428 | |
---|
| 429 | END DO ! jn |
---|
| 430 | |
---|
| 431 | !========================! |
---|
| 432 | CASE (2) !=== SL/BAL CASE ! |
---|
| 433 | !========================! |
---|
| 434 | |
---|
| 435 | zdz0 = deltaz_i_bio(nlay_bio) |
---|
| 436 | |
---|
| 437 | CALL ice_bio_grid(kideb,kiut,nlay_i,.TRUE.) ! compute the new biological grid |
---|
| 438 | |
---|
| 439 | DO jn = 1, ntra_bio |
---|
| 440 | |
---|
| 441 | IF ( flag_active (jn) ) THEN |
---|
| 442 | |
---|
| 443 | ! Old tracer content |
---|
| 444 | zq0(1:nlay_bio-1) = 0. |
---|
| 445 | zq0(nlay_bio) = snicswi * ch_si_bio(jn) |
---|
| 446 | & + icboswi * ch_bo_bio(jn) |
---|
| 447 | & + cbu_i_bio(jn,nlay_bio) * zdz0 |
---|
| 448 | |
---|
| 449 | ! New tracer content (no loss from melt) |
---|
| 450 | zq1(1:nlay_bio-1) = 0. |
---|
| 451 | zq1(nlay_bio) = zq0(nlay_bio) |
---|
| 452 | |
---|
| 453 | ! New bulk concentrations |
---|
| 454 | cbu_i_bio(jn,1:nlay_bio-1) = 0.0 |
---|
| 455 | cbu_i_bio(jn,nlay_bio) = zq1(nlay_bio) / |
---|
| 456 | & deltaz_i_bio(nlay_bio) |
---|
| 457 | |
---|
| 458 | ENDIF ! flag_active |
---|
| 459 | |
---|
| 460 | END DO ! jn |
---|
| 461 | |
---|
| 462 | END SELECT ! zcase |
---|
| 463 | |
---|
| 464 | ! |
---|
| 465 | !----------------------------------------------------------------------- |
---|
| 466 | ! 4) Retrieve brine concentration |
---|
| 467 | !----------------------------------------------------------------------- |
---|
| 468 | ! |
---|
| 469 | !--------------- |
---|
| 470 | ! Interpolation |
---|
| 471 | !--------------- |
---|
| 472 | CALL ice_bio_interp_phy2bio(kideb,kiut,nlay_i,.FALSE.) |
---|
| 473 | ! interpolation of physical variables |
---|
| 474 | ! on the biological grid |
---|
| 475 | !--------------------- |
---|
| 476 | ! Brine concentration |
---|
| 477 | !--------------------- |
---|
| 478 | DO jn = 1, ntra_bio |
---|
| 479 | |
---|
| 480 | IF ( flag_active (jn) .AND. flag_diff(jn) ) THEN |
---|
| 481 | DO layer = 1, nlay_bio |
---|
| 482 | c_i_bio(jn,layer) = cbu_i_bio(jn,layer) / e_i_bio(layer) |
---|
| 483 | END DO ! layer |
---|
| 484 | ENDIF ! flags |
---|
| 485 | |
---|
| 486 | END DO ! jn |
---|
| 487 | |
---|
| 488 | END DO ! ji |
---|
| 489 | |
---|
| 490 | ! |
---|
| 491 | !----------------------------------------------------------------------- |
---|
| 492 | ! 5) Conservation check |
---|
| 493 | !----------------------------------------------------------------------- |
---|
| 494 | ! |
---|
| 495 | !------------------- |
---|
| 496 | ! Conservation test |
---|
| 497 | !------------------- |
---|
| 498 | CALL ice_bio_column(kideb,kiut,ntra_bio,mt_i_bio_final,cbu_i_bio, |
---|
| 499 | & deltaz_i_bio, .FALSE.) |
---|
| 500 | DO jn = 1, ntra_bio |
---|
| 501 | IF ( flag_active(jn) ) THEN |
---|
| 502 | WRITE(numout,*) ' mt_i_bio_final : ', mt_i_bio_final(jn) |
---|
| 503 | ENDIF |
---|
| 504 | END DO |
---|
| 505 | |
---|
| 506 | DO jn = 1, ntra_bio |
---|
| 507 | |
---|
| 508 | IF ( flag_active(jn) ) THEN |
---|
| 509 | |
---|
| 510 | ! Flux due to bottom formation |
---|
| 511 | f_bogr(jn) = ch_bo_bio(jn) / ddtb |
---|
| 512 | f_sigr(jn) = ch_si_bio(jn) / ddtb |
---|
| 513 | f_bogr(jn) = 0.0 |
---|
| 514 | f_sigr(jn) = 0.0 |
---|
| 515 | |
---|
| 516 | ! Flux due to snow ice formation |
---|
| 517 | |
---|
| 518 | ! Bottom flux ( positive upwards ) |
---|
| 519 | ! f_bo_tra(jn) = |
---|
| 520 | ! f_bo_tra(jn) = zswitchw * ( - e_i_bio( nlay_bio ) |
---|
| 521 | ! & * diff_bio * 2.0 |
---|
| 522 | ! & / deltaz_i_bio(nlay_bio) * ( c_i_bio(jn,nlay_bio) |
---|
| 523 | ! & - c_w_bio(jn) ) ) |
---|
| 524 | ! & + zswitchs * ( - qsummer * c_i_bio(jn,nlay_bio) ) |
---|
| 525 | ! & / ddtb |
---|
| 526 | ! & * e_i_bio(nlay_bio) |
---|
| 527 | ! f_su_tra(jn) = zswitchw * 0.0 |
---|
| 528 | ! & + zswitchs * ( qsummer * c_s_bio(jn) ) |
---|
| 529 | ! & / ddtb |
---|
| 530 | !+++++ |
---|
| 531 | WRITE(numout,*) ' f_bogr : ', f_bogr(jn) |
---|
| 532 | WRITE(numout,*) ' f_sigr : ', f_sigr(jn) |
---|
| 533 | !+++++ |
---|
| 534 | |
---|
| 535 | ENDIF |
---|
| 536 | |
---|
| 537 | END DO ! jn |
---|
| 538 | |
---|
| 539 | zerror = 1.0e-9 |
---|
| 540 | CALL ice_bio_conserv(kideb,kiut,ntra_bio,'ice_bio_remap ', |
---|
| 541 | & biotr_i_nam, zerror, |
---|
| 542 | & mt_i_bio_init,mt_i_bio_final, |
---|
| 543 | & f_bogr, f_sigr, ddtb) |
---|
| 544 | ! CALL ice_bio_column(kideb,kiut,ntra_bio,ct_i_bio,cbu_i_bio, |
---|
| 545 | ! & deltaz_i_bio, .FALSE.) |
---|
| 546 | |
---|
| 547 | ! |
---|
| 548 | !----------------------------------------------------------------------- |
---|
| 549 | ! 9) Final output |
---|
| 550 | !----------------------------------------------------------------------- |
---|
| 551 | ! |
---|
| 552 | |
---|
| 553 | WRITE(numout,*) |
---|
| 554 | WRITE(numout,*) ' *** After remapping *** ' |
---|
| 555 | WRITE(numout,*) ' model output ' |
---|
| 556 | DO jn = 1, ntra_bio |
---|
| 557 | IF ( flag_active(jn) ) THEN |
---|
| 558 | WRITE(numout,*) ' biotr_i_nam : ', biotr_i_nam(jn) |
---|
| 559 | WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn,jk), |
---|
| 560 | & jk = 1, nlay_bio ) |
---|
| 561 | IF ( flag_diff(jn) ) |
---|
| 562 | & WRITE(numout,*) ' c_i_bio : ', ( c_i_bio(jn,jk), |
---|
| 563 | & jk = 1, nlay_bio ) |
---|
| 564 | ENDIF |
---|
| 565 | END DO |
---|
| 566 | |
---|
| 567 | WRITE(numout,*) |
---|
| 568 | WRITE(numout,*) ' End of ice_bio_remap ' |
---|
| 569 | |
---|
| 570 | !==============================================================================| |
---|
| 571 | ! Fin de la routine ice_bio_remap |
---|
| 572 | WRITE(numout,*) |
---|
| 573 | |
---|
| 574 | END |
---|