- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8329 r8882 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 10 !!---------------------------------------------------------------------- 11 11 12 !!---------------------------------------------------------------------- 12 13 !! namsbc_cpl : coupled formulation namlist … … 29 30 USE ice ! ice variables 30 31 #endif 31 #if defined key_lim232 USE par_ice_2 ! ice parameters33 USE ice_2 ! ice variables34 #endif35 32 USE cpl_oasis3 ! OASIS3 coupling 36 33 USE geo2ocean ! 37 34 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 38 USE albedo!35 USE ocealb ! 39 36 USE eosbn2 ! 40 37 USE sbcrnf, ONLY : l_rnfcpl … … 44 41 #endif 45 42 #if defined key_lim3 46 USE limthd_dh ! for CALL lim_thd_snwblow43 USE icethd_dh ! for CALL ice_thd_snwblow 47 44 #endif 48 45 ! … … 58 55 59 56 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F9057 PUBLIC sbc_cpl_rcv ! routine called by icestp.F90 61 58 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F9063 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F9059 PUBLIC sbc_cpl_ice_tau ! routine called by icestp.F90 60 PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90 64 61 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 62 … … 176 173 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 177 174 TYPE :: DYNARR 178 REAL(wp), POINTER, DIMENSION(:,:,:) 175 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 179 176 END TYPE DYNARR 180 177 181 178 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 182 179 183 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)180 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 184 181 185 182 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 205 202 ierr(:) = 0 206 203 ! 207 ALLOCATE( alb edo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )204 ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 208 205 209 #if ! defined key_lim3 && ! defined key_ lim2 && ! defined key_cice206 #if ! defined key_lim3 && ! defined key_cice 210 207 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 211 208 #endif … … 504 501 ! 505 502 ! non solar sensitivity mandatory for LIM ice model 506 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4.AND. nn_components /= jp_iam_sas ) &503 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 3 .AND. nn_components /= jp_iam_sas ) & 507 504 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 508 505 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 739 736 ! 2. receiving mixed oce-ice solar radiation 740 737 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 741 CALL albedo_oce( zaos, zacs )738 CALL oce_alb( zaos, zacs ) 742 739 ! Due to lack of information on nebulosity : mean clear/overcast sky 743 alb edo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5740 alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5 744 741 ENDIF 745 742 … … 974 971 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 975 972 !!---------------------------------------------------------------------- 976 USE zdf_oce, ONLY : ln_zdfqiao 977 978 IMPLICIT NONE 979 980 INTEGER, INTENT(in) :: kt ! ocean model time step index 981 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 982 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 973 USE zdf_oce, ONLY : ln_zdfswm 974 ! 975 INTEGER, INTENT(in) :: kt ! ocean model time step index 976 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 977 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 983 978 !! 984 979 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 1146 1141 ! 1147 1142 IF( ln_sdw ) THEN ! Stokes Drift correction activated 1148 !! ========================= !1149 !! Stokes drift u !1150 !! ========================= !1151 IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)1152 !1153 !! ========================= !1154 !! Stokes drift v !1155 !! ========================= !1156 IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)1157 !1158 !! ========================= !1159 !! Wave mean period !1160 !! ========================= !1161 IF( srcv(jpr_wper)%laction )wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)1162 !1163 !! ========================= !1164 !! Significant wave height !1165 !! ========================= !1166 IF( srcv(jpr_hsig)%laction )hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)1167 !1168 !! ========================= !1169 ! ! Vertical mixing Qiao!1170 !! ========================= !1171 IF( srcv(jpr_wnum)%laction .AND. ln_zdf qiao )wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)1143 ! ! ========================= ! 1144 ! ! Stokes drift u ! 1145 ! ! ========================= ! 1146 IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1) 1147 ! 1148 ! ! ========================= ! 1149 ! ! Stokes drift v ! 1150 ! ! ========================= ! 1151 IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1) 1152 ! 1153 ! ! ========================= ! 1154 ! ! Wave mean period ! 1155 ! ! ========================= ! 1156 IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1) 1157 ! 1158 ! ! ========================= ! 1159 ! ! Significant wave height ! 1160 ! ! ========================= ! 1161 IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1) 1162 ! 1163 ! ! ========================= ! 1164 ! ! surface wave mixing ! 1165 ! ! ========================= ! 1166 IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1) 1172 1167 1173 1168 ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 1174 1169 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1175 1170 & .OR. srcv(jpr_hsig)%laction ) THEN 1176 1171 CALL sbc_stokes() 1177 1172 ENDIF … … 1180 1175 ! ! Stress adsorbed by waves ! 1181 1176 ! ! ========================= ! 1182 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1)1177 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 1183 1178 1184 1179 ! ! ========================= ! 1185 1180 ! ! Wave drag coefficient ! 1186 1181 ! ! ========================= ! 1187 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)1182 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 1188 1183 1189 1184 ! Fields received by SAS when OASIS coupling … … 1218 1213 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1219 1214 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1220 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1215 ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1221 1216 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1222 1217 CALL iom_put( 'ssu_m', ssu_m ) … … 1224 1219 IF( srcv(jpr_ocy1)%laction ) THEN 1225 1220 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1226 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1221 vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1227 1222 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1228 1223 CALL iom_put( 'ssv_m', ssv_m ) … … 1528 1523 1529 1524 1530 SUBROUTINE sbc_cpl_ice_flx( p _frld, palbi, psst, pist)1525 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 1531 1526 !!---------------------------------------------------------------------- 1532 1527 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1561 1556 !! 1562 1557 !! ** Details 1563 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice=> provided1558 !! qns_tot = (1-a) * qns_oce + a * qns_ice => provided 1564 1559 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1565 1560 !! 1566 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice=> provided1561 !! qsr_tot = (1-a) * qsr_oce + a * qsr_ice => provided 1567 1562 !! 1568 1563 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce). … … 1578 1573 !! sprecip solid precipitation over the ocean 1579 1574 !!---------------------------------------------------------------------- 1580 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1581 ! optional arguments, used only in 'mixed oce-ice' case 1582 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1583 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1584 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1585 ! 1586 INTEGER :: jl ! dummy loop index 1587 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw 1588 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1589 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1590 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1575 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1576 ! !! ! optional arguments, used only in 'mixed oce-ice' case 1577 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1578 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1579 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1580 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1581 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1582 ! 1583 INTEGER :: ji, jj, jl ! dummy loop index 1584 REAL(wp) :: ztri ! local scalar 1585 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1586 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zevap_ice, zdevap_ice 1587 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1588 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice !!gm , zfrqsr_tr_i 1591 1589 !!---------------------------------------------------------------------- 1592 1590 ! 1593 1591 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1594 1592 ! 1595 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )1596 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )1597 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )1598 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )1599 1600 1593 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1601 zice fr(:,:) = 1.- p_frld(:,:)1602 zcptn (:,:) = rcp * sst_m(:,:)1594 ziceld(:,:) = 1._wp - picefr(:,:) 1595 zcptn (:,:) = rcp * sst_m(:,:) 1603 1596 ! 1604 1597 ! ! ========================= ! … … 1615 1608 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1616 1609 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1617 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)1610 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1618 1611 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1619 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1620 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)1612 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1613 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1621 1614 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1622 1615 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1624 1617 1625 1618 #if defined key_lim3 1626 ! zsnw = snow fraction over ice after wind blowing (= zicefr if no blowing)1627 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )1619 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1620 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) 1628 1621 1629 1622 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1630 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip1623 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1631 1624 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1632 1625 1633 1626 ! --- evaporation over ocean (used later for qemp) --- ! 1634 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)1627 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1635 1628 1636 1629 ! --- evaporation over ice (kg/m2/s) --- ! … … 1662 1655 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1663 1656 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1664 DO jl =1,jpl1657 DO jl = 1, jpl 1665 1658 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1666 1659 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1667 END DO1660 END DO 1668 1661 ELSE 1669 emp_tot(:,:) = 1670 emp_ice(:,:) = 1671 emp_oce(:,:) = 1672 sprecip(:,:) = 1673 tprecip(:,:) = 1674 DO jl =1,jpl1662 emp_tot(:,:) = zemp_tot(:,:) 1663 emp_ice(:,:) = zemp_ice(:,:) 1664 emp_oce(:,:) = zemp_oce(:,:) 1665 sprecip(:,:) = zsprecip(:,:) 1666 tprecip(:,:) = ztprecip(:,:) 1667 DO jl = 1, jpl 1675 1668 evap_ice (:,:,jl) = zevap_ice (:,:) 1676 1669 devap_ice(:,:,jl) = zdevap_ice(:,:) 1677 END DO1670 END DO 1678 1671 ENDIF 1679 1672 1680 1673 #else 1681 zsnw(:,:) = zicefr(:,:)1674 zsnw(:,:) = picefr(:,:) 1682 1675 ! --- Continental fluxes --- ! 1683 1676 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) … … 1694 1687 fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1695 1688 ENDIF 1696 1689 ! 1697 1690 IF( ln_mixcpl ) THEN 1698 1691 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) … … 1706 1699 tprecip(:,:) = ztprecip(:,:) 1707 1700 ENDIF 1708 1701 ! 1709 1702 #endif 1703 1710 1704 ! outputs 1711 1705 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff … … 1718 1712 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1719 1713 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1720 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1714 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1721 1715 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1722 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1716 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1723 1717 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1724 1718 ! … … 1733 1727 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1734 1728 ELSE 1735 DO jl =1,jpl1729 DO jl = 1, jpl 1736 1730 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1737 END DO1731 END DO 1738 1732 ENDIF 1739 1733 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1740 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1734 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1741 1735 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1742 1736 DO jl=1,jpl … … 1745 1739 ENDDO 1746 1740 ELSE 1747 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1748 DO jl =1,jpl1749 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1741 qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1742 DO jl = 1, jpl 1743 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1750 1744 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1751 END DO1745 END DO 1752 1746 ENDIF 1753 1747 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations … … 1755 1749 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1756 1750 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1757 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &1758 & + pist(:,:,1) * zicefr(:,:) ) )1751 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1752 & + pist(:,:,1) * picefr(:,:) ) ) 1759 1753 END SELECT 1760 1754 ! … … 1767 1761 #if defined key_lim3 1768 1762 ! --- non solar flux over ocean --- ! 1769 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1763 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1770 1764 zqns_oce = 0._wp 1771 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)1765 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 1772 1766 1773 1767 ! Heat content per unit mass of snow (J/kg) … … 1776 1770 ENDWHERE 1777 1771 ! Heat content per unit mass of rain (J/kg) 1778 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )1772 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1779 1773 1780 1774 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 1791 1785 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting 1792 1786 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1793 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap1787 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1794 1788 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 1795 1789 … … 1824 1818 ! clem: this formulation is certainly wrong... but better than it was... 1825 1819 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1826 & - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting1820 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting 1827 1821 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1828 1822 & - zemp_ice(:,:) ) * zcptn(:,:) 1829 1823 1830 1824 IF( ln_mixcpl ) THEN 1831 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1825 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1832 1826 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1833 1827 DO jl=1,jpl … … 1841 1835 #endif 1842 1836 ! outputs 1843 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , & 1844 & - frcv(jpr_cal)%z3(:,:,1) * lfus) ! latent heat from calving 1845 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus) ! latent heat from icebergs melting 1846 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus )) ! heat flux from snow (cell average) 1847 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:)) ! heat flux from rain (cell average) 1848 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) & 1849 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average) 1837 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! latent heat from calving 1838 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus ) ! latent heat from icebergs melting 1839 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1840 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1841 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average) 1850 1842 & ) * zcptn(:,:) * tmask(:,:,1) ) 1851 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) & 1852 & * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) 1853 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) & 1854 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1843 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) 1844 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * zsnw(:,:) ) ! heat flux from snow (over ice) 1855 1845 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 1856 1846 ! … … 1866 1856 ELSE 1867 1857 ! Set all category values equal for the moment 1868 DO jl =1,jpl1858 DO jl = 1, jpl 1869 1859 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1870 END DO1860 END DO 1871 1861 ENDIF 1872 1862 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1873 1863 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1874 1864 CASE( 'oce and ice' ) 1875 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1865 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1876 1866 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1877 DO jl =1,jpl1867 DO jl = 1, jpl 1878 1868 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1879 1869 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1880 END DO1870 END DO 1881 1871 ELSE 1882 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1883 DO jl =1,jpl1884 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1872 qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1873 DO jl = 1, jpl 1874 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1885 1875 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1886 END DO1876 END DO 1887 1877 ENDIF 1888 1878 CASE( 'mixed oce-ice' ) … … 1892 1882 ! ( see OASIS3 user guide, 5th edition, p39 ) 1893 1883 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1894 & / ( 1.- ( alb edo_oce_mix(:,: ) * p_frld(:,:) &1895 & + palbi (:,:,1) * zicefr(:,:) ) )1884 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1885 & + palbi (:,:,1) * picefr(:,:) ) ) 1896 1886 END SELECT 1897 1887 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1898 1888 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1899 DO jl =1,jpl1889 DO jl = 1, jpl 1900 1890 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1901 END DO1891 END DO 1902 1892 ENDIF 1903 1893 1904 1894 #if defined key_lim3 1905 1895 ! --- solar flux over ocean --- ! 1906 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1896 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1907 1897 zqsr_oce = 0._wp 1908 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)1898 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 1909 1899 1910 1900 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) … … 1913 1903 1914 1904 IF( ln_mixcpl ) THEN 1915 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1905 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1916 1906 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1917 DO jl =1,jpl1907 DO jl = 1, jpl 1918 1908 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1919 END DO1909 END DO 1920 1910 ELSE 1921 1911 qsr_tot(:,: ) = zqsr_tot(:,: ) … … 1944 1934 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1945 1935 ENDIF 1946 1936 1947 1937 ! ! ========================= ! 1948 1938 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! … … 1953 1943 END SELECT 1954 1944 1955 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1956 ! Used for LIM2 and LIM3 1957 ! Coupled case: since cloud cover is not received from atmosphere 1958 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1959 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1960 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1961 1962 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 1963 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1964 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1965 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1966 ! 1945 #if defined key_lim3 1946 ! ! ========================= ! 1947 ! ! Transmitted Qsr ! [W/m2] 1948 ! ! ========================= ! 1949 SELECT CASE( nice_jules ) 1950 CASE( np_jules_OFF ) !== No Jules coupler ==! 1951 ! 1952 !!gm ! former coding was 1953 !!gm ! Coupled case: since cloud cover is not received from atmosphere 1954 !!gm ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1955 !!gm ! fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1956 !!gm ! fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1957 !!gm 1958 !!gm ! to retrieve that coding, we needed to access h_i & h_s from here 1959 !!gm ! we could even retrieve cloud fraction from the coupler 1960 !!gm ! 1961 !!gm zfrqsr_tr_i(:,:,:) = 0._wp ! surface transmission parameter 1962 !!gm ! 1963 !!gm DO jl = 1, jpl 1964 !!gm DO jj = 1 , jpj 1965 !!gm DO ji = 1, jpi 1966 !!gm ! !--- surface transmission parameter (Grenfell Maykut 77) --- ! 1967 !!gm zfrqsr_tr_i(ji,jj,jl) = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice 1968 !!gm ! 1969 !!gm ! ! --- influence of snow and thin ice --- ! 1970 !!gm IF ( phs(ji,jj,jl) >= 0.0_wp ) zfrqsr_tr_i(ji,jj,jl) = 0._wp ! snow fully opaque 1971 !!gm IF ( phi(ji,jj,jl) <= 0.1_wp ) zfrqsr_tr_i(ji,jj,jl) = 1._wp ! thin ice transmits all solar radiation 1972 !!gm END DO 1973 !!gm END DO 1974 !!gm END DO 1975 !!gm ! 1976 !!gm qsr_ice_tr(:,:,:) = zfrqsr_tr_i(:,:,:) * qsr_ice(:,:,:) ! transmitted solar radiation 1977 !!gm ! 1978 !!gm better coding of the above calculation: 1979 ! 1980 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1981 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 1982 ! 1983 qsr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:) 1984 WHERE( phs(:,:,:) >= 0.0_wp ) qsr_ice_tr(:,:,:) = 0._wp ! snow fully opaque 1985 WHERE( phi(:,:,:) <= 0.1_wp ) qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 1986 !!gm end 1987 ! 1988 CASE( np_jules_ACTIVE ) !== Jules coupler is active ==! 1989 ! 1990 ! ! ===> here we must receive the qsr_ice_tr array from the coupler 1991 ! for now just assume zero (fully opaque ice) 1992 qsr_ice_tr(:,:,:) = 0._wp 1993 ! 1994 END SELECT 1995 ! 1996 #endif 1967 1997 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1968 1998 ! … … 2006 2036 ! we must send the surface potential temperature 2007 2037 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 2008 ELSE 2038 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 2009 2039 ENDIF 2010 2040 ! … … 2059 2089 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 2060 2090 ELSEWHERE 2061 ztmp1(:,:) = alb edo_oce_mix(:,:)2091 ztmp1(:,:) = alb_oce_mix(:,:) 2062 2092 END WHERE 2063 2093 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) … … 2087 2117 2088 2118 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 2089 ztmp1(:,:) = alb edo_oce_mix(:,:) * zfr_l(:,:)2090 DO jl =1,jpl2119 ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:) 2120 DO jl = 1, jpl 2091 2121 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 2092 END DO2122 END DO 2093 2123 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2094 2124 ENDIF … … 2119 2149 SELECT CASE( sn_snd_thick%clcat ) 2120 2150 CASE( 'yes' ) 2121 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl) * a_i(:,:,1:jpl)2122 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl) * a_i(:,:,1:jpl)2151 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 2152 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 2123 2153 CASE( 'no' ) 2124 2154 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 2125 2155 DO jl=1,jpl 2126 ztmp3(:,:,1) = ztmp3(:,:,1) + h t_i(:,:,jl) * a_i(:,:,jl)2127 ztmp4(:,:,1) = ztmp4(:,:,1) + h t_s(:,:,jl) * a_i(:,:,jl)2156 ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl) 2157 ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl) 2128 2158 ENDDO 2129 2159 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) … … 2132 2162 SELECT CASE( sn_snd_thick%clcat ) 2133 2163 CASE( 'yes' ) 2134 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl)2135 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl)2164 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) 2165 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) 2136 2166 CASE( 'no' ) 2137 2167 WHERE( SUM( a_i, dim=3 ) /= 0. ) 2138 ztmp3(:,:,1) = SUM( h t_i * a_i, dim=3 ) / SUM( a_i, dim=3 )2139 ztmp4(:,:,1) = SUM( h t_s * a_i, dim=3 ) / SUM( a_i, dim=3 )2168 ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2169 ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2140 2170 ELSEWHERE 2141 2171 ztmp3(:,:,1) = 0.
Note: See TracChangeset
for help on using the changeset viewer.
