- Timestamp:
- 2014-11-27T17:13:38+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4901 r4902 72 72 !! - Computation of variation of ice volume and mass 73 73 !! - Computation of frldb after lateral accretion and 74 !! update ht_s_ b, ht_i_band tbif_1d(:,:)74 !! update ht_s_1d, ht_i_1d and tbif_1d(:,:) 75 75 !!------------------------------------------------------------------------ 76 INTEGER :: ji,jj,jk,jl ,jm! dummy loop indices77 INTEGER :: layer, nbpac! local integers78 INTEGER :: ii, ij, iter ! - -76 INTEGER :: ji,jj,jk,jl ! dummy loop indices 77 INTEGER :: nbpac ! local integers 78 INTEGER :: ii, ij, iter ! - - 79 79 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde ! local scalars 80 80 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - … … 90 90 REAL(wp) :: zv_newfra 91 91 92 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows92 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows 93 93 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not 94 94 … … 102 102 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget 103 103 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction 104 REAL(wp), POINTER, DIMENSION(:) :: zat_i_lev ! total ice fraction for level ice only (type 1) 105 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom 104 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom 106 105 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 107 106 108 REAL(wp), POINTER, DIMENSION(:,:) :: zv_ old! old volume of ice in category jl109 REAL(wp), POINTER, DIMENSION(:,:) :: za_ old! old area of ice in category jl110 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d 111 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d 112 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_1d 113 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d 114 115 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d 107 REAL(wp), POINTER, DIMENSION(:,:) :: zv_b ! old volume of ice in category jl 108 REAL(wp), POINTER, DIMENSION(:,:) :: za_b ! old area of ice in category jl 109 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i 110 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i 111 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_1d ! 1-D version of oa_i 112 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i 116 115 117 116 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity … … 120 119 CALL wrk_alloc( jpij, jcat ) ! integer 121 120 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 122 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, z at_i_lev, zv_frazb, zvrel_1d )123 CALL wrk_alloc( jpij,jpl, zv_ old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )124 CALL wrk_alloc( jpij, jkmax,jpl, ze_i_1d )121 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 122 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 123 CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 125 124 CALL wrk_alloc( jpi,jpj, zvrel ) 126 125 … … 303 302 304 303 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) 305 CALL tab_2d_1d( nbpac, t_bo_ b(1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) )304 CALL tab_2d_1d( nbpac, t_bo_1d (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 306 305 CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac) , sfx_opw, jpi, jpj, npac(1:nbpac) ) 307 306 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 308 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 309 CALL tab_2d_1d( nbpac, hicol_b (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 307 CALL tab_2d_1d( nbpac, hicol_1d (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 310 308 CALL tab_2d_1d( nbpac, zvrel_1d (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 311 309 … … 320 318 ! Keep old ice areas and volume in memory 321 319 !----------------------------------------- 322 zv_ old(1:nbpac,:) = zv_i_1d(1:nbpac,:)323 za_ old(1:nbpac,:) = za_i_1d(1:nbpac,:)320 zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 321 za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 324 322 !---------------------- 325 323 ! Thickness of new ice … … 328 326 zh_newice(ji) = hiccrit 329 327 END DO 330 IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_ b(1:nbpac)328 IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 331 329 332 330 !---------------------- … … 352 350 DO ji = 1, nbpac 353 351 ztmelts = - tmut * zs_newice(ji) + rtt ! Melting point (K) 354 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_ b(ji) ) &355 & + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_ b(ji) - rtt, -epsi10 ) ) &352 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) & 353 & + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) ) & 356 354 & - rcp * ( ztmelts - rtt ) ) 357 355 END DO ! ji … … 371 369 zEi = - ze_newice(ji) / rhoic ! specific enthalpy of forming ice [J/kg] 372 370 373 zEw = rcp * ( t_bo_ b(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_b[J/kg]371 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_1d [J/kg] 374 372 ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 375 373 … … 442 440 DO ji = 1, nbpac 443 441 jl = jcat(ji) ! categroy in which new ice is put 444 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_ old(ji,jl) ) ) ! 0 if old ice442 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) ) ! 0 if old ice 445 443 END DO 446 444 … … 450 448 zinda = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 451 449 ze_i_1d(ji,jk,jl) = zswinew(ji) * ze_newice(ji) + & 452 & ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_ old(ji,jl) ) &450 & ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) ) & 453 451 & * zinda / MAX( zv_i_1d(ji,jl), epsi20 ) 454 452 END DO … … 492 490 DO ji = 1, nbpac 493 491 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) ) ! 0 if no ice and 1 if yes 494 zoa_i_1d(ji,jl) = za_ old(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * zindb492 zoa_i_1d(ji,jl) = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * zindb 495 493 END DO 496 494 END DO … … 501 499 DO jl = 1, jpl 502 500 DO ji = 1, nbpac 503 zdv = zv_i_1d(ji,jl) - zv_ old(ji,jl)501 zdv = zv_i_1d(ji,jl) - zv_b(ji,jl) 504 502 zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 505 503 END DO … … 520 518 CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 521 519 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 522 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj )523 520 524 521 CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) … … 544 541 CALL wrk_dealloc( jpij, jcat ) ! integer 545 542 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 546 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, z at_i_lev, zv_frazb, zvrel_1d )547 CALL wrk_dealloc( jpij,jpl, zv_ old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )548 CALL wrk_dealloc( jpij, jkmax,jpl, ze_i_1d )543 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 544 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 545 CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 549 546 CALL wrk_dealloc( jpi,jpj, zvrel ) 550 547 !
Note: See TracChangeset
for help on using the changeset viewer.
