Changeset 4672 for branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO
- Timestamp:
- 2014-06-17T17:06:59+02:00 (10 years ago)
- Location:
- branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4659 r4672 167 167 ! !!** ice-dynamic namelist (namicedyn) ** 168 168 INTEGER , PUBLIC :: nevp = 400 !: number of iterations for subcycling 169 INTEGER , PUBLIC :: nlay_i = 5 !: number of layers in the ice170 169 171 170 ! !!** ice-dynamic namelist (namicedyn) ** -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4659 r4672 91 91 REAL(wp) :: zinda, zindb, zareamin 92 92 REAL(wp) :: zfric_u, zqld, zqfr 93 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx, zqfx94 REAL(wp) :: zhfx_err, ztest95 93 ! 96 94 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 97 95 !!------------------------------------------------------------------- 98 96 IF( nn_timing == 1 ) CALL timing_start('limthd') 99 100 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx, zqfx )101 102 ! init debug103 zdq(:) = 0._wp ; zq_ini(:) = 0._wp ; zhfx(:) = 0._wp ; zqfx(:) = 0._wp104 97 105 98 ! conservation test … … 333 326 ! 4.3) Thermodynamic processes 334 327 !-------------------------------- 335 ! --- diag error on heat diffusion - PART 1 --- !336 DO ji = 1, nbpb337 zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + &338 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) )339 END DO340 328 341 329 !---------------------------------! 342 330 ! Ice/Snow Temperature profile ! 343 331 !---------------------------------! 344 CALL lim_thd_dif( 1, nbpb, jl ) 345 346 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 347 CALL lim_thd_enmelt( 1, nbpb ) 348 349 DO ji = 1, nbpb 350 ! --- diag error on heat diffusion - PART 2 --- ! 351 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 352 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 353 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - ftr_ice_1d(ji) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 354 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 355 ! --- correction of qns_ice and surface conduction flux --- ! 356 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 357 fc_su (ji) = fc_su (ji) - zhfx_err 358 ! --- Heat flux at the ice surface in W.m-2 --- ! 359 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 360 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 361 END DO 332 CALL lim_thd_dif( 1, nbpb ) 362 333 363 334 !---------------------------------! 364 335 ! Ice/Snow thicnkess ! 365 336 !---------------------------------! 366 ! --- diag error on heat remapping - PART 1 --- ! 367 DO ji = 1, nbpb 368 zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 369 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 370 END DO 371 372 CALL lim_thd_dh( 1, nbpb, jl ) 337 CALL lim_thd_dh( 1, nbpb ) 373 338 374 339 ! --- Ice enthalpy remapping --- ! 375 CALL lim_thd_ent( 1, nbpb, jl, q_i_b(1:nbpb,:) ) 376 ! 377 ! --- diag error on heat remapping - PART 2 --- ! 378 DO ji = 1, nbpb 379 zdq(ji) = - ( zq_ini(ji) + dq_i(ji) + dq_s(ji) ) & 380 & + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 381 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 382 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + zdq(ji) * a_i_b(ji) * r1_rdtice 383 END DO 384 340 CALL lim_thd_ent( 1, nbpb, q_i_b(1:nbpb,:) ) 341 385 342 !---------------------------------! 386 343 ! --- Ice salinity --- ! … … 528 485 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 529 486 ! 530 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx, zqfx )531 532 487 IF( nn_timing == 1 ) CALL timing_stop('limthd') 533 END SUBROUTINE lim_thd 534 535 536 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 537 !!----------------------------------------------------------------------- 538 !! *** ROUTINE lim_thd_enmelt *** 539 !! 540 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) from temperature 541 !! 542 !! ** Method : Formula (Bitz and Lipscomb, 1999) 543 !!------------------------------------------------------------------- 544 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 545 !! 546 INTEGER :: ji, jk ! dummy loop indices 547 REAL(wp) :: ztmelts, zindb ! local scalar 548 !!------------------------------------------------------------------- 549 ! 550 DO jk = 1, nlay_i ! Sea ice energy of melting 551 DO ji = kideb, kiut 552 ztmelts = - tmut * s_i_b(ji,jk) + rtt 553 zindb = MAX( 0._wp , SIGN( 1._wp , -(t_i_b(ji,jk) - rtt) - epsi10 ) ) 554 q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) ) & 555 & + lfus * ( 1.0 - zindb * ( ztmelts-rtt ) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) ) & 556 & - rcp * ( ztmelts-rtt ) ) 557 END DO 558 END DO 559 DO jk = 1, nlay_s ! Snow energy of melting 560 DO ji = kideb, kiut 561 q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 562 END DO 563 END DO 564 ! 565 END SUBROUTINE lim_thd_enmelt 488 END SUBROUTINE lim_thd 566 489 567 490 SUBROUTINE lim_thd_temp( kideb, kiut ) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4649 r4672 43 43 CONTAINS 44 44 45 SUBROUTINE lim_thd_dh( kideb, kiut , jl)45 SUBROUTINE lim_thd_dh( kideb, kiut ) 46 46 !!------------------------------------------------------------------ 47 47 !! *** ROUTINE lim_thd_dh *** … … 68 68 !!------------------------------------------------------------------ 69 69 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 70 INTEGER , INTENT(in) :: jl ! Thickness cateogry number71 70 !! 72 71 INTEGER :: ji , jk ! dummy loop indices … … 151 150 zintermelt(:) = 0._wp 152 151 icount (:) = 0 153 154 ! debug155 dq_i(:) = 0._wp156 dq_s(:) = 0._wp157 152 158 153 ! initialize layer thicknesses and enthalpies … … 273 268 zh_s (ji) = ht_s_b(ji) / REAL( nlay_s ) 274 269 275 ! clem debug: variation of enthalpy (J.m-2)276 dq_s(ji) = dq_s(ji) + ( zdh_s_pre(ji) + zdh_s_mel(ji) ) * zqprec(ji)277 270 ENDIF 278 271 END DO … … 297 290 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdeltah(ji,jk) ) 298 291 299 ! clem debug: variation of enthalpy (J.m-2)300 dq_s(ji) = dq_s(ji) + zdeltah(ji,jk) * q_s_b(ji,jk)301 292 END DO 302 293 END DO … … 325 316 ! new snow thickness 326 317 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_sub(ji) ) 327 ! clem debug: variation of enthalpy (J.m-2)328 dq_s(ji) = dq_s(ji) + zdh_s_sub(ji) * q_s_b(ji,1)329 318 END DO 330 319 ENDIF … … 397 386 icount(ji) = icount(ji) + zindh 398 387 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 399 400 ! clem debug: variation of enthalpy (J.m-2)401 dq_i(ji) = dq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk)402 388 403 389 ! update heat content (J.m-2) and layer thickness … … 513 499 wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoic * a_i_b(ji) * dh_i_bott(ji) * r1_rdtice 514 500 515 ! clem debug: variation of enthalpy (J.m-2)516 dq_i(ji) = dq_i(ji) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1)517 518 501 ! update heat content (J.m-2) and layer thickness 519 502 qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1) … … 557 540 ! Contribution to mass flux 558 541 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 559 560 ! clem debug: variation of enthalpy (J.m-2)561 dq_i(ji) = dq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk)562 542 563 543 ! update heat content (J.m-2) and layer thickness … … 598 578 ! Contribution to mass flux 599 579 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 600 601 ! clem debug: variation of enthalpy (J.m-2)602 dq_i(ji) = dq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk)603 580 604 581 ! update heat content (J.m-2) and layer thickness … … 664 641 ! ! Contribution to mass flux 665 642 ! wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,1) * r1_rdtice 666 ! ! clem debug: variation of enthalpy (J.m-2)667 ! dq_s(ji) = dq_s(ji) + zdeltah(ji,1) * q_s_b(ji,1)668 643 ! 669 644 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 … … 721 696 wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_b(ji) * dh_snowice(ji) * rhosn * r1_rdtice 722 697 723 ! clem debug: variation of enthalpy (J.m-2)724 dq_s(ji) = dq_s(ji) - dh_snowice(ji) * q_s_b(ji,1)725 dq_i(ji) = dq_i(ji) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw726 727 698 ! update heat content (J.m-2) and layer thickness 728 699 qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4649 r4672 40 40 CONTAINS 41 41 42 SUBROUTINE lim_thd_dif( kideb , kiut , jl)42 SUBROUTINE lim_thd_dif( kideb , kiut ) 43 43 !!------------------------------------------------------------------ 44 44 !! *** ROUTINE lim_thd_dif *** … … 93 93 !!------------------------------------------------------------------ 94 94 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 95 INTEGER , INTENT(in) :: jl ! Thickness cateogry number96 95 97 96 !! * Local variables … … 146 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 147 146 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 147 ! diag errors on heat 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 149 REAL(wp) :: zhfx_err 148 150 !!------------------------------------------------------------------ 149 151 ! … … 155 157 CALL wrk_alloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 156 158 CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 159 160 CALL wrk_alloc( jpij, zdq, zq_ini ) 161 162 ! --- diag error on heat diffusion - PART 1 --- ! 163 zdq(:) = 0._wp ; zq_ini(:) = 0._wp 164 DO ji = kideb, kiut 165 zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 166 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 167 END DO 157 168 158 169 !------------------------------------------------------------------------------! … … 671 682 DO layer = 1, nlay_s 672 683 DO ji = kideb , kiut 673 ii = MOD( npb(ji) - 1, jpi ) + 1674 ij = ( npb(ji) - 1 ) / jpi + 1675 684 t_s_b(ji,layer) = MAX( MIN( t_s_b(ji,layer), rtt ), 190._wp ) 676 685 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) … … 722 731 IF( t_su_b(ji) < rtt ) THEN ! case T_su < 0degC 723 732 hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 724 ELSE 733 ELSE ! case T_su = 0degC 725 734 hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 726 735 ENDIF 727 736 END DO 728 737 738 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 739 CALL lim_thd_enmelt( kideb, kiut ) 740 741 ! --- diag error on heat diffusion - PART 2 --- ! 742 DO ji = kideb, kiut 743 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 744 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 745 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 746 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 747 ! --- correction of qns_ice and surface conduction flux --- ! 748 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 749 fc_su (ji) = fc_su (ji) - zhfx_err 750 ! --- Heat flux at the ice surface in W.m-2 --- ! 751 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 752 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 753 END DO 754 729 755 ! 730 756 CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) … … 735 761 CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 736 762 CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 763 CALL wrk_dealloc( jpij, zdq, zq_ini ) 737 764 738 765 END SUBROUTINE lim_thd_dif 766 767 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 768 !!----------------------------------------------------------------------- 769 !! *** ROUTINE lim_thd_enmelt *** 770 !! 771 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) from temperature 772 !! 773 !! ** Method : Formula (Bitz and Lipscomb, 1999) 774 !!------------------------------------------------------------------- 775 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 776 ! 777 INTEGER :: ji, jk ! dummy loop indices 778 REAL(wp) :: ztmelts, zindb ! local scalar 779 !!------------------------------------------------------------------- 780 ! 781 DO jk = 1, nlay_i ! Sea ice energy of melting 782 DO ji = kideb, kiut 783 ztmelts = - tmut * s_i_b(ji,jk) + rtt 784 zindb = MAX( 0._wp , SIGN( 1._wp , -(t_i_b(ji,jk) - rtt) - epsi10 ) ) 785 q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) ) & 786 & + lfus * ( 1.0 - zindb * ( ztmelts-rtt ) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) ) & 787 & - rcp * ( ztmelts-rtt ) ) 788 END DO 789 END DO 790 DO jk = 1, nlay_s ! Snow energy of melting 791 DO ji = kideb, kiut 792 q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 793 END DO 794 END DO 795 ! 796 END SUBROUTINE lim_thd_enmelt 739 797 740 798 #else -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r4649 r4672 36 36 PRIVATE 37 37 38 PUBLIC lim_thd_ent ! called by lim _thd38 PUBLIC lim_thd_ent ! called by limthd and limthd_lac 39 39 40 40 REAL(wp) :: epsi20 = 1.e-20 ! constant values … … 48 48 CONTAINS 49 49 50 SUBROUTINE lim_thd_ent( kideb, kiut, jl,qnew )50 SUBROUTINE lim_thd_ent( kideb, kiut, qnew ) 51 51 !!------------------------------------------------------------------- 52 52 !! *** ROUTINE lim_thd_ent *** … … 74 74 !!------------------------------------------------------------------- 75 75 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 76 INTEGER , INTENT(in) :: jl ! Thickness cateogry number77 76 78 REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew ! new enthlapies ( remapped)77 REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew ! new enthlapies (J.m-3, remapped) 79 78 80 INTEGER :: ji ,ii,ij! dummy loop indices79 INTEGER :: ji ! dummy loop indices 81 80 INTEGER :: jk0, jk1 ! old/new layer indices 82 REAL(wp) :: ztmelts ! temperature of melting 83 REAL(wp) :: zswitch, zaaa, zbbb, zccc, zdiscrim ! converting enthalpy to temperature 81 REAL(wp) :: zswitch 84 82 ! 85 83 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces … … 139 137 DO jk1 = 1, nlay_i 140 138 DO ji = kideb, kiut 141 zswitch = 139 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 142 140 qnew(ji,jk1) = zswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 ) 143 141 ENDDO 144 142 ENDDO 143 144 ! --- diag error on heat remapping --- ! 145 ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac), 146 ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 147 DO ji = kideb, kiut 148 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_b(ji) * r1_rdtice * & 149 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 150 END DO 151 145 152 ! 146 153 CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4659 r4672 329 329 ! Salinity of new ice 330 330 !---------------------- 331 332 331 SELECT CASE ( num_sal ) 333 332 CASE ( 1 ) ! Sice = constant … … 343 342 END SELECT 344 343 345 346 344 !------------------------- 347 345 ! Heat content of new ice … … 354 352 & - rcp * ( ztmelts - rtt ) ) 355 353 END DO ! ji 354 356 355 !---------------- 357 356 ! Age of new ice … … 395 394 END DO 396 395 397 398 396 !----------------- 399 397 ! Area of new ice … … 407 405 !------------------------------------------------------------------------------! 408 406 409 !------------------------ -------------------410 ! Compute excessive new ice area and volume411 !------------------------ -------------------407 !------------------------ 408 ! 6.1) lateral ice growth 409 !------------------------ 412 410 ! If lateral ice growth gives an ice concentration gt 1, then 413 411 ! we keep the excessive volume in memory and attribute it later to bottom accretion … … 422 420 zdv_res(ji) = 0._wp 423 421 ENDIF 424 END DO ! ji 425 426 !------------------------------------------------ 427 ! Laterally redistribute new ice volume and area 428 !------------------------------------------------ 422 END DO 423 424 ! find which category to fill 429 425 zat_i_1d(:) = 0._wp 430 426 DO jl = 1, jpl … … 433 429 za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 434 430 zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji) 435 jcat (ji) = jl431 jcat (ji) = jl 436 432 ENDIF 437 433 zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d (ji,jl) … … 439 435 END DO 440 436 441 !---------------------------------- 442 ! Heat content - lateral accretion 443 !---------------------------------- 444 DO ji = 1, nbpac 445 jl = jcat(ji) ! categroy in which new ice is put 437 ! Heat content 438 DO ji = 1, nbpac 439 jl = jcat(ji) ! categroy in which new ice is put 446 440 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) ) ) ! 0 if old ice 447 441 END DO … … 457 451 END DO 458 452 459 !----------------------------------------------- 460 ! Add excessive volume of new ice at the bottom461 !----------------------------------------------- 453 !------------------------------------------------ 454 ! 6.2) bottom ice growth + ice enthalpy remapping 455 !------------------------------------------------ 462 456 DO jl = 1, jpl 457 458 ! for remapping 463 459 h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 464 460 qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 465 466 461 DO jk = 1, nlay_i 467 462 DO ji = 1, nbpac … … 471 466 END DO 472 467 468 ! new volumes including lateral/bottom accretion + residual 473 469 DO ji = 1, nbpac 474 470 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 475 471 zv_newfra = zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 476 472 za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl) 477 473 zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 474 475 ! for remapping 478 476 h_i_old (ji,nlay_i+1) = zv_newfra 479 477 qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 480 481 zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra482 478 ENDDO 483 479 484 480 ! --- Ice enthalpy remapping --- ! 485 CALL lim_thd_ent( 1, nbpac, jl, ze_i_1d(1:nbpac,:,jl) ) 481 IF( zv_newfra > 0._wp ) THEN 482 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 483 ENDIF 486 484 487 485 ENDDO … … 500 498 ! Update salinity 501 499 !----------------- 502 !clem IF( num_sal == 2 ) THEN 503 DO jl = 1, jpl 504 DO ji = 1, nbpac 505 zdv = zv_i_1d(ji,jl) - zv_old(ji,jl) 506 zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 507 END DO 508 END DO 509 !clem ENDIF 500 DO jl = 1, jpl 501 DO ji = 1, nbpac 502 zdv = zv_i_1d(ji,jl) - zv_old(ji,jl) 503 zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 504 END DO 505 END DO 510 506 511 507 !------------------------------------------------------------------------------! 512 ! 8) Change 2D vectors to 1D vectors508 ! 7) Change 2D vectors to 1D vectors 513 509 !------------------------------------------------------------------------------! 514 510 DO jl = 1, jpl … … 531 527 532 528 !------------------------------------------------------------------------------! 533 ! 9) Change units for e_i529 ! 8) Change units for e_i 534 530 !------------------------------------------------------------------------------! 535 531 DO jl = 1, jpl -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
r2528 r4672 13 13 ! !!! ice thermodynamics 14 14 INTEGER, PUBLIC, PARAMETER :: jkmax = 6 !: maximum number of ice layers 15 INTEGER, PUBLIC, PARAMETER :: nlay_i = 5 !: number of ice layers 15 16 INTEGER, PUBLIC, PARAMETER :: nlay_s = 1 !: number of snow layers 16 17 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4659 r4672 124 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_b !: Snow enthalpy per unit volume 125 125 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dq_i !: variation of ice enthalpy (debug)127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dq_s !: variation of snw enthalpy (debug)128 129 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qh_i_old !: ice heat content (q*h, J.m-2) 130 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_i_old !: ice thickness layer (m) … … 171 168 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 172 169 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 173 & dq_i (jpij) , dq_s (jpij), t_s_b(jpij,nlay_s),&170 & t_s_b(jpij,nlay_s), & 174 171 & t_i_b(jpij,jkmax), s_i_b(jpij,jkmax) , & 175 172 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , &
Note: See TracChangeset
for help on using the changeset viewer.