| 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 ) |
|---|
| 171 | & ch_bo_bio(jn) = e_skel * c_w_bio(jn) * MAX( dh_i_bott(ji), |
|---|
| 172 | & 0.0 ) |
|---|
| 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 |
|---|
![(please configure the [header_logo] section in trac.ini)](/lim1d/chrome/site/your_project_logo.png){kind=logo}
