- Timestamp:
- 2015-02-02T18:31:34+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4990 r5051 27 27 USE wrk_nemo ! work arrays 28 28 USE prtctl ! Print control 29 ! Check budget (Rousset) 29 30 30 USE iom ! I/O manager 31 31 USE lib_fortran ! glob_sum … … 40 40 PUBLIC lim_itd_me_icestrength 41 41 PUBLIC lim_itd_me_init 42 PUBLIC lim_itd_me_zapsmall 43 PUBLIC lim_itd_me_alloc ! called by iceini.F90 42 PUBLIC lim_itd_me_alloc ! called by sbc_lim_init 44 43 45 44 !----------------------------------------------------------------------- … … 375 374 !-----------------------------------------------------------------------------! 376 375 CALL lim_var_glo2eqv 377 CALL lim_ itd_me_zapsmall376 CALL lim_var_zapsmall 378 377 379 378 … … 632 631 633 632 ! ! Zero out categories with very small areas 634 CALL lim_ itd_me_zapsmall633 CALL lim_var_zapsmall 635 634 636 635 !------------------------------------------------------------------------------! … … 1375 1374 END SUBROUTINE lim_itd_me_init 1376 1375 1377 1378 SUBROUTINE lim_itd_me_zapsmall1379 !!-------------------------------------------------------------------1380 !! *** ROUTINE lim_itd_me_zapsmall ***1381 !!1382 !! ** Purpose : Remove too small sea ice areas and correct salt fluxes1383 !!1384 !! history :1385 !! author: William H. Lipscomb, LANL1386 !! Nov 2003: Modified by Julie Schramm to conserve volume and energy1387 !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with1388 !! additions to local freshwater, salt, and heat fluxes1389 !! 9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code1390 !!-------------------------------------------------------------------1391 INTEGER :: ji, jj, jl, jk ! dummy loop indices1392 INTEGER :: icells ! number of cells with ice to zap1393 1394 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace1395 REAL(wp) :: zmask_glo, zsal, zvi, zvs, zei, zes1396 !!gm REAL(wp) :: xtmp ! temporary variable1397 !!-------------------------------------------------------------------1398 1399 CALL wrk_alloc( jpi, jpj, zmask )1400 1401 ! to be sure that at_i is the sum of a_i(jl)1402 at_i(:,:) = SUM( a_i(:,:,:), dim=3 )1403 1404 DO jl = 1, jpl1405 !-----------------------------------------------------------------1406 ! Count categories to be zapped.1407 !-----------------------------------------------------------------1408 icells = 01409 zmask(:,:) = 0._wp1410 DO jj = 1, jpj1411 DO ji = 1, jpi1412 IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN1413 zmask(ji,jj) = 1._wp1414 ENDIF1415 END DO1416 END DO1417 !zmask_glo = glob_sum(zmask)1418 !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean '1419 1420 !-----------------------------------------------------------------1421 ! Zap ice energy and use ocean heat to melt ice1422 !-----------------------------------------------------------------1423 1424 DO jk = 1, nlay_i1425 DO jj = 1 , jpj1426 DO ji = 1 , jpi1427 zei = e_i(ji,jj,jk,jl)1428 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) )1429 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj)1430 ! update exchanges with ocean1431 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <01432 END DO1433 END DO1434 END DO1435 1436 DO jj = 1 , jpj1437 DO ji = 1 , jpi1438 1439 zsal = smv_i(ji,jj,jl)1440 zvi = v_i(ji,jj,jl)1441 zvs = v_s(ji,jj,jl)1442 zes = e_s(ji,jj,1,jl)1443 !-----------------------------------------------------------------1444 ! Zap snow energy and use ocean heat to melt snow1445 !-----------------------------------------------------------------1446 ! xtmp = esnon(i,j,n) / dt ! < 01447 ! fhnet(i,j) = fhnet(i,j) + xtmp1448 ! fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp1449 ! xtmp is greater than 01450 ! fluxes are positive to the ocean1451 ! here the flux has to be negative for the ocean1452 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )1453 1454 !-----------------------------------------------------------------1455 ! zap ice and snow volume, add water and salt to ocean1456 !-----------------------------------------------------------------1457 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj)1458 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1459 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1460 v_s (ji,jj,jl) = v_s (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1461 t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)1462 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1463 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1464 e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )1465 ! additional condition1466 IF( v_s(ji,jj,jl) <= epsi10 ) THEN1467 v_s(ji,jj,jl) = 0._wp1468 e_s(ji,jj,1,jl) = 0._wp1469 ENDIF1470 ! update exchanges with ocean1471 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice1472 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice1473 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice1474 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <01475 END DO1476 END DO1477 END DO ! jl1478 1479 ! to be sure that at_i is the sum of a_i(jl)1480 at_i(:,:) = SUM( a_i(:,:,:), dim=3 )1481 !1482 CALL wrk_dealloc( jpi, jpj, zmask )1483 !1484 END SUBROUTINE lim_itd_me_zapsmall1485 1486 1376 #else 1487 1377 !!---------------------------------------------------------------------- … … 1497 1387 SUBROUTINE lim_itd_me_init 1498 1388 END SUBROUTINE lim_itd_me_init 1499 SUBROUTINE lim_itd_me_zapsmall1500 END SUBROUTINE lim_itd_me_zapsmall1501 1389 #endif 1502 1390 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
