- Timestamp:
- 2016-11-21T10:38:43+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7277 r7278 1006 1006 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1007 1007 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1008 IF( srcv(jpr_soce)%laction .AND. l n_useCT ) THEN ! make sure that sst_m is the potential temperature1008 IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature 1009 1009 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1010 1010 ENDIF … … 1370 1370 ! 1371 1371 INTEGER :: jl ! dummy loop index 1372 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1373 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, z sprecip, ztprecip, zqns_tot, zqsr_tot1374 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zqns_ice, zqsr_ice, zdqns_ice1375 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM31372 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1373 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice 1374 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1375 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1376 1376 !!---------------------------------------------------------------------- 1377 1377 ! 1378 1378 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1379 1379 ! 1380 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1381 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1380 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1381 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 1382 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1383 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1382 1384 1383 1385 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1414 1416 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1415 1417 END SELECT 1416 1417 IF( iom_use('subl_ai_cea') ) & 1418 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1419 ! 1420 ! ! runoffs and calving (put in emp_tot) 1418 #if defined key_lim3 1419 ! zsnw = snow percentage over ice after wind blowing 1420 zsnw(:,:) = 0._wp 1421 CALL lim_thd_snwblow( p_frld, zsnw ) 1422 1423 ! --- evaporation (used later in sbccpl) --- ! 1424 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) 1425 1426 ! --- evaporation over ice (kg/m2/s) --- ! 1427 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1428 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1429 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1430 zdevap_ice(:,:) = 0._wp 1431 1432 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1433 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1434 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1435 1436 ! --- runoffs (included in emp later on) --- ! 1437 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1438 1439 ! --- calving (put in emp_tot and emp_oce) --- ! 1440 IF( srcv(jpr_cal)%laction ) THEN 1441 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1442 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1443 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1444 ENDIF 1445 1446 IF( ln_mixcpl ) THEN 1447 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1448 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1449 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1450 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1451 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1452 DO jl=1,jpl 1453 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1454 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1455 ENDDO 1456 ELSE 1457 emp_tot(:,:) = zemp_tot(:,:) 1458 emp_ice(:,:) = zemp_ice(:,:) 1459 emp_oce(:,:) = zemp_oce(:,:) 1460 sprecip(:,:) = zsprecip(:,:) 1461 tprecip(:,:) = ztprecip(:,:) 1462 DO jl=1,jpl 1463 evap_ice (:,:,jl) = zevap_ice (:,:) 1464 devap_ice(:,:,jl) = zdevap_ice(:,:) 1465 ENDDO 1466 ENDIF 1467 1468 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1469 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1470 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1471 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1472 #else 1473 ! Sublimation over sea-ice (cell average) 1474 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 1475 ! runoffs and calving (put in emp_tot) 1421 1476 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1422 1477 IF( srcv(jpr_cal)%laction ) THEN … … 1442 1497 IF( iom_use('snow_ai_cea') ) & 1443 1498 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1499 #endif 1444 1500 1445 1501 ! ! ========================= ! … … 1497 1553 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1498 1554 1499 #if defined key_lim3 1500 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1501 1502 ! --- evaporation --- ! 1503 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1504 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1505 ! but it is incoherent WITH the ice model 1506 DO jl=1,jpl 1507 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1508 ENDDO 1509 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1510 1511 ! --- evaporation minus precipitation --- ! 1512 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1513 1555 #if defined key_lim3 1514 1556 ! --- non solar flux over ocean --- ! 1515 1557 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1517 1559 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1518 1560 1519 ! --- heat flux associated with emp --- ! 1520 zsnw(:,:) = 0._wp 1521 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1561 ! --- heat flux associated with emp (W/m2) --- ! 1522 1562 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1523 1563 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1524 1564 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1525 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1526 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1527 1565 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1566 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1567 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1568 ! qevap_ice=0 since we consider Tice=0°C 1569 1528 1570 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1529 1571 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1530 1572 1531 ! --- total non solar flux --- ! 1532 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1573 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1574 DO jl = 1, jpl 1575 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C 1576 END DO 1577 1578 ! --- total non solar flux (including evap/precip) --- ! 1579 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1533 1580 1534 1581 ! --- in case both coupled/forced are active, we must mix values --- ! … … 1537 1584 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1538 1585 DO jl=1,jpl 1539 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1586 qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:) 1587 qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:) 1540 1588 ENDDO 1541 1589 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1542 1590 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1543 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)1591 qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:) 1544 1592 ELSE 1545 1593 qns_tot (:,: ) = zqns_tot (:,: ) 1546 1594 qns_oce (:,: ) = zqns_oce (:,: ) 1547 1595 qns_ice (:,:,:) = zqns_ice (:,:,:) 1548 q prec_ice(:,:) = zqprec_ice(:,:)1549 q emp_oce (:,:) = zqemp_oce (:,:)1550 ENDIF1551 1552 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )1596 qevap_ice(:,:,:) = zqevap_ice(:,:,:) 1597 qprec_ice(:,: ) = zqprec_ice(:,: ) 1598 qemp_oce (:,: ) = zqemp_oce (:,: ) 1599 qemp_ice (:,: ) = zqemp_ice (:,: ) 1600 ENDIF 1553 1601 #else 1554 !1555 1602 ! clem: this formulation is certainly wrong... but better than it was before... 1556 1603 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: … … 1619 1666 1620 1667 #if defined key_lim3 1621 CALL wrk_alloc( jpi,jpj, zqsr_oce )1622 1668 ! --- solar flux over ocean --- ! 1623 1669 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1627 1673 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1628 1674 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1629 1630 CALL wrk_dealloc( jpi,jpj, zqsr_oce )1631 1675 #endif 1632 1676 … … 1679 1723 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1680 1724 1681 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1682 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1725 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1726 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 1727 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1728 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1683 1729 ! 1684 1730 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1719 1765 1720 1766 IF ( nn_components == jp_iam_opa ) THEN 1721 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l n_useCT on the received part1767 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 1722 1768 ELSE 1723 1769 ! we must send the surface potential temperature 1724 IF( l n_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )1770 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1725 1771 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1726 1772 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
