- Timestamp:
- 2016-03-22T18:17:23+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6204 r6399 1378 1378 ! 1379 1379 INTEGER :: jl ! dummy loop index 1380 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, z sprecip, ztprecip, zqns_tot, zqsr_tot1382 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zqns_ice, zqsr_ice, zdqns_ice1383 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM31380 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice 1382 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1383 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1384 1384 !!---------------------------------------------------------------------- 1385 1385 ! 1386 1386 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1387 1387 ! 1388 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1389 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1388 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1389 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 1390 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1391 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1390 1392 1391 1393 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1423 1425 END SELECT 1424 1426 1425 IF( iom_use('subl_ai_cea') ) & 1426 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1427 ! 1428 ! ! runoffs and calving (put in emp_tot) 1427 #if defined key_lim3 1428 ! zsnw = snow percentage over ice after wind blowing 1429 zsnw(:,:) = 0._wp 1430 CALL lim_thd_snwblow( p_frld, zsnw ) 1431 1432 ! --- evaporation (kg/m2/s) --- ! 1433 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1434 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1435 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1436 zdevap_ice(:,:) = 0._wp 1437 1438 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1439 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1440 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1441 1442 ! Sublimation over sea-ice (cell average) 1443 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 1444 ! runoffs and calving (put in emp_tot) 1445 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1446 IF( srcv(jpr_cal)%laction ) THEN 1447 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1448 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1449 ENDIF 1450 1451 IF( ln_mixcpl ) THEN 1452 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1453 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1454 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1455 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1456 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1457 DO jl=1,jpl 1458 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1459 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1460 ENDDO 1461 ELSE 1462 emp_tot(:,:) = zemp_tot(:,:) 1463 emp_ice(:,:) = zemp_ice(:,:) 1464 emp_oce(:,:) = zemp_oce(:,:) 1465 sprecip(:,:) = zsprecip(:,:) 1466 tprecip(:,:) = ztprecip(:,:) 1467 DO jl=1,jpl 1468 evap_ice (:,:,jl) = zevap_ice (:,:) 1469 devap_ice(:,:,jl) = zdevap_ice(:,:) 1470 ENDDO 1471 ENDIF 1472 1473 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1474 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1475 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1476 #else 1477 ! Sublimation over sea-ice (cell average) 1478 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 1479 ! runoffs and calving (put in emp_tot) 1429 1480 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1430 1481 IF( srcv(jpr_cal)%laction ) THEN … … 1450 1501 IF( iom_use('snow_ai_cea') ) & 1451 1502 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1503 #endif 1452 1504 1453 1505 ! ! ========================= ! … … 1505 1557 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1506 1558 1507 #if defined key_lim3 1508 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1509 1559 #if defined key_lim3 1510 1560 ! --- evaporation --- ! 1511 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation1512 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice1513 ! but it is incoherent WITH the ice model1514 DO jl=1,jpl1515 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1)1516 ENDDO1517 1561 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1518 1519 ! --- evaporation minus precipitation --- !1520 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)1521 1562 1522 1563 ! --- non solar flux over ocean --- ! … … 1525 1566 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1526 1567 1527 ! --- heat flux associated with emp --- ! 1528 zsnw(:,:) = 0._wp 1529 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1568 ! --- heat flux associated with emp (W/m2) --- ! 1530 1569 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1531 1570 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1532 1571 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1533 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1534 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1535 1572 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1573 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1574 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1575 ! qevap_ice=0 since we consider Tice=0°C 1576 1536 1577 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1537 1578 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1538 1579 1539 ! --- total non solar flux --- ! 1540 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1580 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1581 DO jl = 1, jpl 1582 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C 1583 END DO 1584 1585 ! --- total non solar flux (including evap/precip) --- ! 1586 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1541 1587 1542 1588 ! --- in case both coupled/forced are active, we must mix values --- ! … … 1545 1591 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1546 1592 DO jl=1,jpl 1547 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1593 qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:) 1594 qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:) 1548 1595 ENDDO 1549 1596 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1550 1597 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1551 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)1598 qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:) 1552 1599 ELSE 1553 1600 qns_tot (:,: ) = zqns_tot (:,: ) 1554 1601 qns_oce (:,: ) = zqns_oce (:,: ) 1555 1602 qns_ice (:,:,:) = zqns_ice (:,:,:) 1556 q prec_ice(:,:) = zqprec_ice(:,:)1557 q emp_oce (:,:) = zqemp_oce (:,:)1558 ENDIF1559 1560 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )1603 qevap_ice(:,:,:) = zqevap_ice(:,:,:) 1604 qprec_ice(:,: ) = zqprec_ice(:,: ) 1605 qemp_oce (:,: ) = zqemp_oce (:,: ) 1606 qemp_ice (:,: ) = zqemp_ice (:,: ) 1607 ENDIF 1561 1608 #else 1562 1563 1609 ! clem: this formulation is certainly wrong... but better than it was... 1564 1610 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: … … 1577 1623 qns_ice(:,:,:) = zqns_ice(:,:,:) 1578 1624 ENDIF 1579 1580 1625 #endif 1581 1626 … … 1628 1673 1629 1674 #if defined key_lim3 1630 CALL wrk_alloc( jpi,jpj, zqsr_oce )1631 1675 ! --- solar flux over ocean --- ! 1632 1676 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1636 1680 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1637 1681 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1638 1639 CALL wrk_dealloc( jpi,jpj, zqsr_oce )1640 1682 #endif 1641 1683 … … 1688 1730 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1689 1731 1690 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1691 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1732 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1733 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 1734 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1735 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1692 1736 ! 1693 1737 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
Note: See TracChangeset
for help on using the changeset viewer.