- Timestamp:
- 2017-09-15T20:07:33+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerdgrft.F90
r8518 r8531 12 12 !! 'key_lim3' LIM-3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 USE par_oce ! ocean parameters15 14 USE dom_oce ! ocean domain 16 15 USE phycst ! physical constants (ocean directory) … … 31 30 PRIVATE 32 31 33 PUBLIC ice_rdgrft ! called by ice_stp34 PUBLIC ice_ rdgrft_strength ! called by icerhg_evp35 PUBLIC ice_rdgrft_init ! called by ice_stp32 PUBLIC ice_rdgrft ! called by icestp 33 PUBLIC ice_strength ! called by icerhg_evp 34 PUBLIC ice_rdgrft_init ! called by icedyn 36 35 37 36 ! Variables shared among ridging subroutines 38 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: asum ! sum of total ice and open water area 39 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aksum ! ratio of area removed to area ridged 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a thorn! participation function; fraction of ridging/closing associated w/ category n39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: apartf ! participation function; fraction of ridging/closing associated w/ category n 41 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmin ! minimum ridge thickness 42 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmax ! maximum ridge thickness 43 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hraft ! thickness of rafted ice 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: krdg! thickness of ridging ice / mean ridge thickness43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hi_hrdg ! thickness of ridging ice / mean ridge thickness 45 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aridge ! participating ice ridging 46 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: araft ! participating ice rafting 47 46 ! 48 REAL(wp), PARAMETER :: krdgmin = 1.1_wp ! min ridge thickness multiplier49 REAL(wp), PARAMETER :: kraft = 0.5_wp ! rafting multipliyer50 REAL(wp) :: zdrho !47 REAL(wp), PARAMETER :: hrdg_hi_min = 1.1_wp ! min ridge thickness multiplier: min(hrdg/hi) 48 REAL(wp), PARAMETER :: hi_hrft = 0.5_wp ! rafting multipliyer: (hi/hraft) 49 REAL(wp) :: zdrho ! 51 50 ! 52 ! ** namelist (nam ice_rdgrft) **51 ! ** namelist (namdyn_rdgrft) ** 53 52 LOGICAL :: ln_str_H79 ! ice strength parameterization (Hibler79) 54 53 REAL(wp) :: rn_pstar ! determines ice strength, Hibler JPO79 … … 83 82 !! *** ROUTINE ice_rdgrft_alloc *** 84 83 !!---------------------------------------------------------------------! 85 ALLOCATE( asum (jpi,jpj) , a thorn(jpi,jpj,0:jpl) , aksum (jpi,jpj) , &86 & hrmin(jpi,jpj,jpl) , hraft (jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , &87 & hrmax(jpi,jpj,jpl) , krdg(jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=ice_rdgrft_alloc )84 ALLOCATE( asum (jpi,jpj) , apartf (jpi,jpj,0:jpl) , aksum (jpi,jpj) , & 85 & hrmin(jpi,jpj,jpl) , hraft (jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 86 & hrmax(jpi,jpj,jpl) , hi_hrdg(jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=ice_rdgrft_alloc ) 88 87 89 88 IF( lk_mpp ) CALL mpp_sum ( ice_rdgrft_alloc ) … … 124 123 INTEGER :: niter ! local integer 125 124 INTEGER :: iterate_ridging ! if =1, repeat the ridging 126 REAL(wp) :: z a! local scalar125 REAL(wp) :: zfac ! local scalar 127 126 REAL(wp), DIMENSION(jpi,jpj) :: closing_net ! net rate at which area is removed (1/s) 128 127 ! ! (ridging ice area - area of new ridges) / dt … … 150 149 !-----------------------------------------------------------------------------! 151 150 ! 152 CALL ice_rdgrft_prep ! prepare ridging151 CALL rdgrft_prep ! prepare ridging 153 152 ! 154 153 DO jj = 1, jpj ! Initialize arrays. … … 203 202 DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax ) 204 203 205 ! 3. 2closing_gross204 ! 3.1 closing_gross 206 205 !-----------------------------------------------------------------------------! 207 206 ! Based on the ITD of ridging and ridged ice, convert the net … … 216 215 DO jj = 1, jpj 217 216 DO ji = 1, jpi 218 z a = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice219 IF ( z a < 0._wp .AND. za> - ato_i(ji,jj) ) THEN ! would lead to negative ato_i220 opning(ji,jj) = a thorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice221 ELSEIF( z a > 0._wp .AND. za> ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN ! would lead to ato_i > asum222 opning(ji,jj) = a thorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice217 zfac = ( opning(ji,jj) - apartf(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 218 IF ( zfac < 0._wp .AND. zfac > - ato_i(ji,jj) ) THEN ! would lead to negative ato_i 219 opning(ji,jj) = apartf(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 220 ELSEIF( zfac > 0._wp .AND. zfac > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN ! would lead to ato_i > asum 221 opning(ji,jj) = apartf(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 223 222 ENDIF 224 223 END DO … … 232 231 DO jj = 1, jpj 233 232 DO ji = 1, jpi 234 z a = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice235 IF( z a> a_i(ji,jj,jl) ) THEN236 closing_gross(ji,jj) = closing_gross(ji,jj) * a_i(ji,jj,jl) / z a233 zfac = apartf(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 234 IF( zfac > a_i(ji,jj,jl) ) THEN 235 closing_gross(ji,jj) = closing_gross(ji,jj) * a_i(ji,jj,jl) / zfac 237 236 ENDIF 238 237 END DO … … 240 239 END DO 241 240 242 ! 3. 3Redistribute area, volume, and energy.241 ! 3.2 Redistribute area, volume, and energy. 243 242 !-----------------------------------------------------------------------------! 244 CALL ice_rdgrft_ridgeshift( opning, closing_gross )243 CALL rdgrft_shift( opning, closing_gross ) 245 244 246 ! 3. 4Compute total area of ice plus open water after ridging.245 ! 3.3 Compute total area of ice plus open water after ridging. 247 246 !-----------------------------------------------------------------------------! 248 247 ! This is in general not equal to one because of divergence during transport 249 248 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 250 249 251 ! 3. 5Do we keep on iterating?250 ! 3.4 Do we keep on iterating? 252 251 !-----------------------------------------------------------------------------! 253 252 ! Check whether asum = 1. If not (because the closing and opening … … 276 275 ! 277 276 IF( iterate_ridging == 1 ) THEN 278 CALL ice_rdgrft_prep277 CALL rdgrft_prep 279 278 IF( niter > nitermax ) THEN 280 279 WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' … … 295 294 296 295 297 SUBROUTINE ice_rdgrft_prep296 SUBROUTINE rdgrft_prep 298 297 !!---------------------------------------------------------------------! 299 !! *** ROUTINE ice_rdgrft_prep ***298 !! *** ROUTINE rdgrft_prep *** 300 299 !! 301 300 !! ** Purpose : preparation for ridging and strength calculations … … 319 318 END WHERE 320 319 321 !------------------------------------------------------------------------------! 322 ! 1) Participation function 323 !------------------------------------------------------------------------------! 320 !----------------------------------------------------------------- 321 ! 1) Participation function: a(h) = b(h).g(h) (apartf) 322 !----------------------------------------------------------------- 323 ! Compute the participation function apartf; this is analogous to 324 ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 325 ! area lost from category n due to ridging/closing 326 ! apartf(n) = total area lost due to ridging/closing 327 ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 328 ! 329 ! The expressions for apartf are found by integrating b(h)g(h) between 330 ! the category boundaries. 331 ! apartf is always >= 0 and SUM(apartf(0:jpl))=1 332 !----------------------------------------------------------------- 324 333 ! 325 334 ! Compute total area of ice plus open water. … … 337 346 END DO 338 347 339 ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)340 !--------------------------------------------------------------------------------------------------341 ! Compute the participation function athorn; this is analogous to342 ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).343 ! area lost from category n due to ridging/closing344 ! athorn(n) = total area lost due to ridging/closing345 ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).346 !347 ! The expressions for athorn are found by integrating b(h)g(h) between348 ! the category boundaries.349 ! athorn is always >= 0 and SUM(athorn(0:jpl))=1350 !-----------------------------------------------------------------351 348 ! 352 349 IF( ln_partf_lin ) THEN !--- Linear formulation (Thorndike et al., 1975) … … 355 352 DO ji = 1, jpi 356 353 IF ( zGsum(ji,jj,jl) < rn_gstar ) THEN 357 a thorn(ji,jj,jl) = z1_gstar * ( zGsum(ji,jj,jl) - zGsum(ji,jj,jl-1) ) * &354 apartf(ji,jj,jl) = z1_gstar * ( zGsum(ji,jj,jl) - zGsum(ji,jj,jl-1) ) * & 358 355 & ( 2._wp - ( zGsum(ji,jj,jl-1) + zGsum(ji,jj,jl) ) * z1_gstar ) 359 356 ELSEIF( zGsum(ji,jj,jl-1) < rn_gstar ) THEN 360 a thorn(ji,jj,jl) = z1_gstar * ( rn_gstar - zGsum(ji,jj,jl-1) ) * &357 apartf(ji,jj,jl) = z1_gstar * ( rn_gstar - zGsum(ji,jj,jl-1) ) * & 361 358 & ( 2._wp - ( zGsum(ji,jj,jl-1) + rn_gstar ) * z1_gstar ) 362 359 ELSE 363 a thorn(ji,jj,jl) = 0._wp360 apartf(ji,jj,jl) = 0._wp 364 361 ENDIF 365 362 END DO … … 374 371 END DO 375 372 DO jl = 0, jpl 376 a thorn(:,:,jl) = zGsum(:,:,jl-1) - zGsum(:,:,jl)373 apartf(:,:,jl) = zGsum(:,:,jl-1) - zGsum(:,:,jl) 377 374 END DO 378 375 ! … … 384 381 DO jj = 1, jpj 385 382 DO ji = 1, jpi 386 aridge(ji,jj,jl) = ( 1._wp + TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) ) * 0.5_wp * a thorn(ji,jj,jl)387 araft (ji,jj,jl) = a thorn(ji,jj,jl) - aridge(ji,jj,jl)383 aridge(ji,jj,jl) = ( 1._wp + TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) ) * 0.5_wp * apartf(ji,jj,jl) 384 araft (ji,jj,jl) = apartf(ji,jj,jl) - aridge(ji,jj,jl) 388 385 END DO 389 386 END DO 390 387 END DO 391 388 ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN !- ridging alone 392 aridge(:,:,:) = a thorn(:,:,1:jpl)389 aridge(:,:,:) = apartf(:,:,1:jpl) 393 390 araft (:,:,:) = 0._wp 394 391 ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN !- rafting alone 395 392 aridge(:,:,:) = 0._wp 396 araft (:,:,:) = a thorn(:,:,1:jpl)393 araft (:,:,:) = apartf(:,:,1:jpl) 397 394 ELSE !- no ridging & no rafting 398 395 aridge(:,:,:) = 0._wp … … 408 405 ! This parameterization is a modified version of Hibler (1980). 409 406 ! The mean ridging thickness, zhmean, is proportional to hi^(0.5) 410 ! and for very thick ridging ice must be >= krdgmin*hi407 ! and for very thick ridging ice must be >= hrdg_hi_min*hi 411 408 ! 412 409 ! The minimum ridging thickness, hrmin, is equal to 2*hi … … 426 423 !----------------------------------------------------------------- 427 424 428 aksum(:,:) = athorn(:,:,0) 425 aksum(:,:) = apartf(:,:,0) 426 zdummy = 1._wp / hi_hrft 429 427 ! Transfer function 430 428 DO jl = 1, jpl !all categories have a specific transfer function 431 429 DO jj = 1, jpj 432 430 DO ji = 1, jpi 433 IF ( a thorn(ji,jj,jl) > 0._wp ) THEN434 zhmean = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin )435 hrmin (ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( zhmean + ht_i(ji,jj,jl) ) )436 hrmax (ji,jj,jl) = 2._wp * zhmean - hrmin(ji,jj,jl)437 hraft (ji,jj,jl) = ht_i(ji,jj,jl) / kraft438 krdg(ji,jj,jl) = ht_i(ji,jj,jl) / MAX( zhmean, epsi20 )431 IF ( apartf(ji,jj,jl) > 0._wp ) THEN 432 zhmean = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * hrdg_hi_min ) 433 hrmin (ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( zhmean + ht_i(ji,jj,jl) ) ) 434 hrmax (ji,jj,jl) = 2._wp * zhmean - hrmin(ji,jj,jl) 435 hraft (ji,jj,jl) = ht_i(ji,jj,jl) * zdummy 436 hi_hrdg(ji,jj,jl) = ht_i(ji,jj,jl) / MAX( zhmean, epsi20 ) 439 437 ! 440 438 ! Normalization factor : aksum, ensures mass conservation 441 aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) ) &442 & + araft (ji,jj,jl) * ( 1._wp - kraft)439 aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - hi_hrdg(ji,jj,jl) ) & 440 & + araft (ji,jj,jl) * ( 1._wp - hi_hrft ) 443 441 ELSE 444 hrmin (ji,jj,jl)= 0._wp445 hrmax (ji,jj,jl)= 0._wp446 hraft (ji,jj,jl)= 0._wp447 krdg (ji,jj,jl)= 1._wp442 hrmin (ji,jj,jl) = 0._wp 443 hrmax (ji,jj,jl) = 0._wp 444 hraft (ji,jj,jl) = 0._wp 445 hi_hrdg(ji,jj,jl) = 1._wp 448 446 ENDIF 449 447 END DO … … 451 449 END DO 452 450 ! 453 END SUBROUTINE ice_rdgrft_prep454 455 456 SUBROUTINE ice_rdgrft_ridgeshift( opning, closing_gross )451 END SUBROUTINE rdgrft_prep 452 453 454 SUBROUTINE rdgrft_shift( opning, closing_gross ) 457 455 !!---------------------------------------------------------------------- 458 !! *** ROUTINE ice_rdgrft_strength***456 !! *** ROUTINE rdgrft_shift *** 459 457 !! 460 458 !! ** Purpose : shift ridging ice among thickness categories of ice thickness … … 463 461 !! and add to thicker ice categories. 464 462 !!---------------------------------------------------------------------- 465 REAL(wp), DIMENSION(jpi,jpj), INTENT(in 466 REAL(wp), DIMENSION(jpi,jpj), INTENT(in 467 ! 468 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices469 INTEGER :: ij! horizontal index, combines i and j loops470 INTEGER :: icells! number of cells with a_i > puny471 REAL(wp) :: hL, hR, farea ! left and right limits of integration and new area going to jl2472 473 INTEGER , DIMENSION(jpij) :: indxi, indxj ! compressed indices474 REAL(wp), DIMENSION(jpij) :: zswitch, fvol ! new ridge volume going to jl2463 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: opning ! rate of opening due to divergence/shear 464 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: closing_gross ! rate at which area retreats, excluding area of new ridges 465 ! 466 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices 467 INTEGER :: ij ! horizontal index, combines i and j loops 468 INTEGER :: icells ! number of cells with a_i > puny 469 REAL(wp) :: hL, hR, farea ! left and right limits of integration and new area going to jl2 470 471 INTEGER , DIMENSION(jpij) :: indxi, indxj ! compressed indices 472 REAL(wp), DIMENSION(jpij) :: zswitch, fvol ! new ridge volume going to jl2 475 473 476 474 REAL(wp), DIMENSION(jpij) :: afrac ! fraction of category area ridged … … 482 480 REAL(wp), DIMENSION(jpij) :: aprdg2 ! pond area of ridging ice 483 481 ! END MV MP 2016 484 REAL(wp), DIMENSION(jpij) :: dhr , dhr2! hrmax - hrmin & hrmax^2 - hrmin^2485 486 REAL(wp), DIMENSION(jpij) :: vrdg1 ! volume of ice ridged487 REAL(wp), DIMENSION(jpij) :: vrdg2 ! volume of new ridges488 REAL(wp), DIMENSION(jpij) :: vsw ! volume of seawater trapped into ridges489 REAL(wp), DIMENSION(jpij) :: srdg1 ! sal*volume of ice ridged490 REAL(wp), DIMENSION(jpij) :: srdg2 ! sal*volume of new ridges491 REAL(wp), DIMENSION(jpij) :: smsw ! sal*volume of water trapped into ridges482 REAL(wp), DIMENSION(jpij) :: dhr, dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 483 484 REAL(wp), DIMENSION(jpij) :: vrdg1 ! volume of ice ridged 485 REAL(wp), DIMENSION(jpij) :: vrdg2 ! volume of new ridges 486 REAL(wp), DIMENSION(jpij) :: vsw ! volume of seawater trapped into ridges 487 REAL(wp), DIMENSION(jpij) :: srdg1 ! sal*volume of ice ridged 488 REAL(wp), DIMENSION(jpij) :: srdg2 ! sal*volume of new ridges 489 REAL(wp), DIMENSION(jpij) :: smsw ! sal*volume of water trapped into ridges 492 490 REAL(wp), DIMENSION(jpij) :: oirdg1, oirdg2 ! ice age of ice ridged 493 491 … … 503 501 REAL(wp), DIMENSION(jpij) :: oirft1, oirft2 ! ice age of ice rafted 504 502 505 REAL(wp), DIMENSION(jpij,nlay_i) :: eirft 506 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg1 507 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg2 508 REAL(wp), DIMENSION(jpij,nlay_i) :: ersw 503 REAL(wp), DIMENSION(jpij,nlay_i) :: eirft ! ice energy of rafting ice 504 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg1 ! enth*volume of ice ridged 505 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg2 ! enth*volume of new ridges 506 REAL(wp), DIMENSION(jpij,nlay_i) :: ersw ! enth of water trapped into ridges 509 507 !!---------------------------------------------------------------------- 510 508 … … 515 513 DO ji = 1, jpi 516 514 ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) + & 517 & ( opning(ji,jj) - a thorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice )515 & ( opning(ji,jj) - apartf(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice ) 518 516 END DO 519 517 END DO 520 518 521 519 !----------------------------------------------------------------- 522 ! 3) Pump everything from ice which is being ridged / rafted520 ! 2) Pump everything from ice which is being ridged / rafted 523 521 !----------------------------------------------------------------- 524 522 ! Compute the area, volume, and energy of ice ridging in each … … 528 526 529 527 !------------------------------------------------ 530 ! 3.1) Identify grid cells with nonzero ridging528 ! 2.1) Identify grid cells with nonzero ridging 531 529 !------------------------------------------------ 532 530 icells = 0 533 531 DO jj = 1, jpj 534 532 DO ji = 1, jpi 535 IF( a thorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN533 IF( apartf(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN 536 534 icells = icells + 1 537 535 indxi(icells) = ji … … 545 543 546 544 !-------------------------------------------------------------------- 547 ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)545 ! 2.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 548 546 !-------------------------------------------------------------------- 549 547 ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice … … 551 549 552 550 !--------------------------------------------------------------- 553 ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1551 ! 2.3) Compute ridging /rafting fractions, make sure afrac <=1 554 552 !--------------------------------------------------------------- 555 553 afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging 556 554 afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting 557 ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1)558 arft2(ij) = arft1(ij) * kraft555 ardg2(ij) = ardg1(ij) * hi_hrdg(ji,jj,jl1) 556 arft2(ij) = arft1(ij) * hi_hrft 559 557 560 558 !-------------------------------------------------------------------------- 561 ! 3.4) Substract area, volume, and energy from ridging559 ! 2.4) Substract area, volume, and energy from ridging 562 560 ! / rafting category n1. 563 561 !-------------------------------------------------------------------------- … … 571 569 IF ( nn_pnd_scheme > 0 ) THEN 572 570 aprdg1(ij) = a_ip(ji,jj, jl1) * afrac(ij) 573 aprdg2(ij) = a_ip(ji,jj, jl1) * afrac(ij) * krdg(ji,jj,jl1)571 aprdg2(ij) = a_ip(ji,jj, jl1) * afrac(ij) * hi_hrdg(ji,jj,jl1) 574 572 vprdg(ij) = v_ip(ji,jj, jl1) * afrac(ij) 575 573 ENDIF … … 577 575 srdg1 (ij) = smv_i(ji,jj, jl1) * afrac(ij) 578 576 oirdg1(ij) = oa_i (ji,jj, jl1) * afrac(ij) 579 oirdg2(ij) = oa_i (ji,jj, jl1) * afrac(ij) * krdg(ji,jj,jl1)577 oirdg2(ij) = oa_i (ji,jj, jl1) * afrac(ij) * hi_hrdg(ji,jj,jl1) 580 578 581 579 ! rafting volumes, heat contents ... … … 585 583 IF ( nn_pnd_scheme > 0 ) THEN 586 584 aprft1(ij) = a_ip (ji,jj, jl1) * afrft(ij) 587 aprft2(ij) = a_ip (ji,jj, jl1) * afrft(ij) * kraft585 aprft2(ij) = a_ip (ji,jj, jl1) * afrft(ij) * hi_hrft 588 586 vprft(ij) = v_ip(ji,jj,jl1) * afrft(ij) 589 587 ENDIF … … 593 591 smrft (ij) = smv_i(ji,jj, jl1) * afrft(ij) 594 592 oirft1(ij) = oa_i (ji,jj, jl1) * afrft(ij) 595 oirft2(ij) = oa_i (ji,jj, jl1) * afrft(ij) * kraft593 oirft2(ij) = oa_i (ji,jj, jl1) * afrft(ij) * hi_hrft 596 594 597 595 !----------------------------------------------------------------- 598 ! 3.5) Compute properties of new ridges596 ! 2.5) Compute properties of new ridges 599 597 !----------------------------------------------------------------- 600 598 smsw(ij) = vsw(ij) * sss_m(ji,jj) ! salt content of seawater frozen in voids … … 612 610 613 611 !------------------------------------------ 614 ! 3.7Put the snow somewhere in the ocean612 ! 2.6 Put the snow somewhere in the ocean 615 613 !------------------------------------------ 616 614 ! Place part of the snow lost by ridging into the ocean. … … 627 625 ! MV MP 2016 628 626 !------------------------------------------ 629 ! 3.XPut the melt pond water in the ocean627 ! 2.7 Put the melt pond water in the ocean 630 628 !------------------------------------------ 631 629 ! Place part of the melt pond volume into the ocean. … … 637 635 638 636 !----------------------------------------------------------------- 639 ! 3.8 Compute quantities used to apportion ice among categories637 ! 2.8 Compute quantities used to apportion ice among categories 640 638 ! in the n2 loop below 641 639 !----------------------------------------------------------------- … … 662 660 663 661 !-------------------------------------------------------------------- 664 ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and662 ! 2.9 Compute ridging ice enthalpy, remove it from ridging ice and 665 663 ! compute ridged ice enthalpy 666 664 !-------------------------------------------------------------------- … … 689 687 690 688 !------------------------------------------------------------------------------- 691 ! 4) Add area, volume, and energy of new ridge to each category jl2689 ! 3) Add area, volume, and energy of new ridge to each category jl2 692 690 !------------------------------------------------------------------------------- 693 691 DO jl2 = 1, jpl … … 710 708 !!gm see above IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN 711 709 IF( hi_max(jl2-1) < hraft(ji,jj,jl1) .AND. hraft(ji,jj,jl1) <= hi_max(jl2) ) THEN ; zswitch(ij) = 1._wp 712 ELSE ; zswitch(ij) = 0._wp 710 ELSE ; zswitch(ij) = 0._wp 713 711 ENDIF 714 712 ! … … 743 741 END DO ! jl1 (deforming categories) 744 742 ! 745 END SUBROUTINE ice_rdgrft_ridgeshift746 747 748 SUBROUTINE ice_ rdgrft_strength743 END SUBROUTINE rdgrft_shift 744 745 746 SUBROUTINE ice_strength 749 747 !!---------------------------------------------------------------------- 750 !! *** ROUTINE ice_ rdgrft_strength ***748 !! *** ROUTINE ice_strength *** 751 749 !! 752 750 !! ** Purpose : computes ice strength used in dynamics routines of ice thickness … … 767 765 768 766 ! !--------------------------------------------------! 769 CALL ice_rdgrft_prep! Thickness distribution of ridging and ridged ice !767 CALL rdgrft_prep ! Thickness distribution of ridging and ridged ice ! 770 768 ! !--------------------------------------------------! 771 769 … … 775 773 z1_3 = 1._wp / 3._wp 776 774 DO jl = 1, jpl 777 WHERE( a thorn(:,:,jl) > 0._wp )778 strength(:,:) = - a thorn(:,:,jl) * ht_i(:,:,jl) * ht_i(:,:,jl) & ! PE loss from deforming ice779 & + 2._wp * araft (:,:,jl) * ht_i (:,:,jl) * ht_i(:,:,jl) & ! PE gain from rafting ice780 & + aridge(:,:,jl) * krdg(:,:,jl) * z1_3 * &! PE gain from ridging ice781 & ( hrmax(:,:,jl) * hrmax (:,:,jl) +&782 & hrmin(:,:,jl) * hrmin (:,:,jl) +&783 & hrmax(:,:,jl) * hrmin (:,:,jl) )775 WHERE( apartf(:,:,jl) > 0._wp ) 776 strength(:,:) = - apartf(:,:,jl) * ht_i (:,:,jl) * ht_i(:,:,jl) & ! PE loss from deforming ice 777 & + 2._wp * araft (:,:,jl) * ht_i (:,:,jl) * ht_i(:,:,jl) & ! PE gain from rafting ice 778 & + aridge(:,:,jl) * hi_hrdg(:,:,jl) * z1_3 * & ! PE gain from ridging ice 779 & ( hrmax(:,:,jl) * hrmax (:,:,jl) + & 780 & hrmin(:,:,jl) * hrmin (:,:,jl) + & 781 & hrmax(:,:,jl) * hrmin (:,:,jl) ) 784 782 ELSEWHERE 785 783 strength(:,:) = 0._wp … … 844 842 END SELECT 845 843 ! 846 END SUBROUTINE ice_ rdgrft_strength844 END SUBROUTINE ice_strength 847 845 848 846 … … 854 852 !! to the mechanical ice redistribution 855 853 !! 856 !! ** Method : Read the nam ice_rdgrft namelist854 !! ** Method : Read the namdyn_rdgrft namelist 857 855 !! and check the parameters values 858 856 !! called at the first timestep (nit000) 859 857 !! 860 !! ** input : Namelist nam ice_rdgrft858 !! ** input : Namelist namdyn_rdgrft 861 859 !!------------------------------------------------------------------- 862 860 INTEGER :: ios ! Local integer output status for namelist read 863 861 !! 864 NAMELIST/nam ice_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, &862 NAMELIST/namdyn_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, & 865 863 & ln_str_R75, rn_perdg, & 866 864 & rn_csrdg , & … … 872 870 ! 873 871 REWIND( numnam_ice_ref ) ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 874 READ ( numnam_ice_ref, nam ice_rdgrft, IOSTAT = ios, ERR = 901)875 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam ice_rdgrft in reference namelist', lwp )876 ! 877 REWIND( numnam_ice_cfg ) ! Namelist nam ice_rdgrft in configuration namelist : Ice mechanical ice redistribution878 READ ( numnam_ice_cfg, nam ice_rdgrft, IOSTAT = ios, ERR = 902 )879 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam ice_rdgrft in configuration namelist', lwp )880 IF(lwm) WRITE ( numoni, nam ice_rdgrft )872 READ ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 873 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 874 ! 875 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 876 READ ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 877 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 878 IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 881 879 ! 882 880 IF (lwp) THEN ! control print … … 884 882 WRITE(numout,*) 'ice_rdgrft_init: ice parameters for ridging/rafting ' 885 883 WRITE(numout,*) '~~~~~~~~~~~~~~~' 886 WRITE(numout,*) ' Namelist nam ice_rdgrft'884 WRITE(numout,*) ' Namelist namdyn_rdgrft:' 887 885 WRITE(numout,*) ' ice strength parameterization Hibler (1979) ln_str_H79 = ', ln_str_H79 888 886 WRITE(numout,*) ' 1st bulk-rheology parameter rn_pstar = ', rn_pstar … … 915 913 ENDIF 916 914 ! ! allocate tke arrays 917 IF( ice_rdgrft_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ice_rdgrft_init 915 IF( ice_rdgrft_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ice_rdgrft_init: unable to allocate arrays' ) 918 916 ! 919 917 END SUBROUTINE ice_rdgrft_init
Note: See TracChangeset
for help on using the changeset viewer.
