Changeset 14590
- Timestamp:
- 2021-03-05T14:21:05+01:00 (3 years ago)
- Location:
- NEMO/releases/r4.0/r4.0-HEAD/src
- Files:
-
- 5 edited
-
ICE/icectl.F90 (modified) (2 diffs)
-
ICE/icesbc.F90 (modified) (2 diffs)
-
ICE/iceupdate.F90 (modified) (3 diffs)
-
OCE/SBC/sbccpl.F90 (modified) (23 diffs)
-
OCE/SBC/sbcice_cice.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icectl.F90
r14026 r14590 801 801 !! DO jj = 1, jpj 802 802 !! DO ji = 1, jpi 803 !! zdiag_mass2D(ji,jj) = wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_spr(ji,jj) + wfx_sub(ji,jj) &804 !! & + diag_vice(ji,jj) + diag_vsnw(ji,jj) - diag_adv_mass(ji,jj)803 !! zdiag_mass2D(ji,jj) = wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_spr(ji,jj) + wfx_sub(ji,jj) + wfx_pnd(ji,jj) & 804 !! & + diag_vice(ji,jj) + diag_vsnw(ji,jj) + diag_vpnd(ji,jj) - diag_adv_mass(ji,jj) 805 805 !! zdiag_salt2D(ji,jj) = sfx(ji,jj) + diag_sice(ji,jj) - diag_adv_salt(ji,jj) 806 806 !! zdiag_heat2D(ji,jj) = qt_oce_ai(ji,jj) - qt_atm_oi(ji,jj) + diag_heat(ji,jj) - diag_adv_heat(ji,jj) … … 815 815 816 816 ! -- mass diag -- ! 817 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub &818 & + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rdt_ice817 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd & 818 & + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) * rdt_ice 819 819 zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rdt_ice 820 820 -
NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icesbc.F90
r14026 r14590 140 140 CASE( jp_blk ) !--- bulk formulation 141 141 CALL blk_ice_flx ( t_su, h_s, h_i, alb_ice ) ! 142 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )142 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 143 143 IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 144 144 ! ! compute conduction flux and surface temperature (as in Jules surface module) … … 146 146 & CALL blk_ice_qcn ( ln_virtual_itd, t_su, t_bo, h_s, h_i ) 147 147 CASE ( jp_purecpl ) !--- coupled formulation 148 CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )148 CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 149 149 IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 150 150 END SELECT -
NEMO/releases/r4.0/r4.0-HEAD/src/ICE/iceupdate.F90
r14582 r14590 105 105 ! Net heat flux on top of the ice-ocean (W.m-2) 106 106 !---------------------------------------------- 107 qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 107 IF( ln_cndflx ) THEN ! ice-atm interface = conduction (and melting) fluxes 108 qt_atm_oi(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) + & 109 & SUM( a_i_b * ( qcn_ice + qml_ice + qtr_ice_top ), dim=3 ) + qemp_ice(:,:) 110 ELSE ! ice-atm interface = solar and non-solar fluxes 111 qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 112 ENDIF 108 113 109 114 ! --- case we bypass ice thermodynamics --- ! … … 121 126 ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) 122 127 !--------------------------------------------------- 123 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 124 128 IF( ln_cndflx ) THEN ! ice-atm interface = conduction (and melting) fluxes 129 zqsr = ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) + SUM( a_i_b (ji,jj,:) * qtr_ice_bot(ji,jj,:) ) 130 ELSE ! ice-atm interface = solar and non-solar fluxes 131 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 132 ENDIF 133 125 134 ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 126 135 !--------------------------------------------------- 127 qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 128 & - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 129 & + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 130 & + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 131 136 IF( ln_icethd ) THEN 137 qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 138 & - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 139 & + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 140 & + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 141 ENDIF 142 132 143 ! New qsr and qns used to compute the oceanic heat flux at the next time step 133 144 !---------------------------------------------------------------------------- … … 282 293 IF( iom_use('hfxcndtop' ) ) CALL iom_put( 'hfxcndtop' , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 283 294 !! IF( iom_use('hfxmelt' ) ) CALL iom_put( 'hfxmelt' , SUM( qml_ice * a_i_b, dim=3 ) ) ! Surface melt flux 284 !! IF( iom_use('hfxldmelt' ) ) CALL iom_put( 'hfxldmelt' , fhld * at_i_b ) ! Heat in lead for ice melting 295 !! IF( iom_use('hfxldmelt' ) ) CALL iom_put( 'hfxldmelt' , fhld * at_i_b ) ! Heat in lead for ice melting 285 296 !! IF( iom_use('hfxldgrow' ) ) CALL iom_put( 'hfxldgrow' , qlead * r1_rdtice ) ! Heat in lead for ice growth 286 297 287 298 ! controls 288 299 !--------- -
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC/sbccpl.F90
r14101 r14590 120 120 INTEGER, PARAMETER :: jpr_tauwy = 56 ! y component of the ocean stress from waves 121 121 INTEGER, PARAMETER :: jpr_ts_ice = 57 ! Sea ice surface temp 122 !!INTEGER, PARAMETER :: jpr_qtrice = 58 ! Transmitted solar thru sea-ice 122 123 123 124 INTEGER, PARAMETER :: jprcv = 57 ! total number of fields received … … 193 194 sn_rcv_wdrag, sn_rcv_wfreq 194 195 ! ! Other namelist parameters 196 !! TYPE(FLD_C) :: sn_rcv_qtrice 197 !! ! ! Other namelist parameters 195 198 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 196 199 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models … … 227 230 !! *** FUNCTION sbc_cpl_alloc *** 228 231 !!---------------------------------------------------------------------- 229 INTEGER :: ierr( 5)232 INTEGER :: ierr(4) 230 233 !!---------------------------------------------------------------------- 231 234 ierr(:) = 0 … … 237 240 #endif 238 241 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 239 #if defined key_si3 || defined key_cice 240 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 241 #endif 242 ! 243 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 242 ! 243 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 244 244 245 245 sbc_cpl_alloc = MAXVAL( ierr ) … … 277 277 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 278 278 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 279 & sn_rcv_ts_ice 279 & sn_rcv_ts_ice !!, sn_rcv_qtrice 280 280 !!--------------------------------------------------------------------- 281 281 ! … … 319 319 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' 320 320 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 321 !! WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')' 321 322 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 322 323 WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' … … 575 576 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 576 577 ! 577 ! ! ------------------------- !578 ! ! ice topmelt and botmelt!579 ! ! ------------------------- !578 ! ! --------------------------------- ! 579 ! ! ice topmelt and conduction flux ! 580 ! ! --------------------------------- ! 580 581 srcv(jpr_topm )%clname = 'OTopMlt' 581 582 srcv(jpr_botm )%clname = 'OBotMlt' … … 588 589 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 589 590 ENDIF 591 !! ! ! --------------------------- ! 592 !! ! ! transmitted solar thru ice ! 593 !! ! ! --------------------------- ! 594 !! srcv(jpr_qtrice)%clname = 'OQtr' 595 !! IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN 596 !! IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN 597 !! srcv(jpr_qtrice)%nct = nn_cats_cpl 598 !! ELSE 599 !! CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' ) 600 !! ENDIF 601 !! srcv(jpr_qtrice)%laction = .TRUE. 602 !! ENDIF 603 590 604 ! ! ------------------------- ! 591 605 ! ! ice skin temperature ! … … 844 858 END SELECT 845 859 846 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office)847 #if defined key_si3 || defined key_cice848 a_i_last_couple(:,:,:) = 0._wp849 #endif850 860 ! ! ------------------------- ! 851 861 ! ! Ice Meltponds ! … … 1516 1526 !! ** Action : return ptau_i, ptau_j, the stress over the ice 1517 1527 !!---------------------------------------------------------------------- 1518 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1519 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1528 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2] 1529 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1520 1530 !! 1521 1531 INTEGER :: ji, jj ! dummy loop indices … … 1524 1534 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1525 1535 !!---------------------------------------------------------------------- 1536 ! 1537 #if defined key_si3 || defined key_cice 1526 1538 ! 1527 1539 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1600 1612 ENDIF 1601 1613 ! 1614 #endif 1615 ! 1602 1616 END SUBROUTINE sbc_cpl_ice_tau 1603 1617 1604 1618 1605 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )1619 SUBROUTINE sbc_cpl_ice_flx( kt, picefr, palbi, psst, pist, phs, phi ) 1606 1620 !!---------------------------------------------------------------------- 1607 1621 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1645 1659 !! are provided but not included in emp here. Only runoff will 1646 1660 !! be included in emp in other parts of NEMO code 1661 !! 1662 !! ** Note : In case of the ice-atm coupling with conduction fluxes (such as Jules interface for the Met-Office), 1663 !! qsr_ice and qns_ice are not provided and they are not supposed to be used in the ice code. 1664 !! However, by precaution we also "fake" qns_ice and qsr_ice this way: 1665 !! qns_ice = qml_ice + qcn_ice ?? 1666 !! qsr_ice = qtr_ice_top ?? 1667 !! 1647 1668 !! ** Action : update at each nf_ice time step: 1648 1669 !! qns_tot, qsr_tot non-solar and solar total heat fluxes … … 1653 1674 !! sprecip solid precipitation over the ocean 1654 1675 !!---------------------------------------------------------------------- 1676 INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple) 1655 1677 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1656 1678 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling … … 1669 1691 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1670 1692 !!---------------------------------------------------------------------- 1693 ! 1694 #if defined key_si3 || defined key_cice 1695 ! 1696 IF( kt == nit000 ) THEN 1697 ! allocate ice fractions from last coupling time here and not in sbc_cpl_init because of jpl 1698 IF( .NOT.ALLOCATED(a_i_last_couple) ) ALLOCATE( a_i_last_couple(jpi,jpj,jpl) ) 1699 ! initialize to a_i for the 1st time step 1700 a_i_last_couple(:,:,:) = a_i(:,:,:) 1701 ENDIF 1671 1702 ! 1672 1703 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1696 1727 CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl') 1697 1728 END SELECT 1698 1699 #if defined key_si31700 1729 1701 1730 ! --- evaporation over ice (kg/m2/s) --- ! … … 1789 1818 ENDIF 1790 1819 1791 #else 1792 zsnw(:,:) = picefr(:,:) 1793 ! --- Continental fluxes --- ! 1794 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1795 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1796 ENDIF 1797 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1798 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1799 ENDIF 1800 IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1801 fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1802 rnf(:,:) = rnf(:,:) + fwficb(:,:) 1803 ENDIF 1804 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1805 fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1806 ENDIF 1807 ! 1808 IF( ln_mixcpl ) THEN 1809 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1810 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1811 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1812 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1813 ELSE 1814 emp_tot(:,:) = zemp_tot(:,:) 1815 emp_ice(:,:) = zemp_ice(:,:) 1816 sprecip(:,:) = zsprecip(:,:) 1817 tprecip(:,:) = ztprecip(:,:) 1818 ENDIF 1819 ! 1820 #endif 1821 1820 !! for CICE ?? 1821 !!$ zsnw(:,:) = picefr(:,:) 1822 !!$ ! --- Continental fluxes --- ! 1823 !!$ IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1824 !!$ rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1825 !!$ ENDIF 1826 !!$ IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1827 !!$ zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1828 !!$ ENDIF 1829 !!$ IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1830 !!$ fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1831 !!$ rnf(:,:) = rnf(:,:) + fwficb(:,:) 1832 !!$ ENDIF 1833 !!$ IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1834 !!$ fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1835 !!$ ENDIF 1836 !!$ ! 1837 !!$ IF( ln_mixcpl ) THEN 1838 !!$ emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1839 !!$ emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1840 !!$ sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1841 !!$ tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1842 !!$ ELSE 1843 !!$ emp_tot(:,:) = zemp_tot(:,:) 1844 !!$ emp_ice(:,:) = zemp_ice(:,:) 1845 !!$ sprecip(:,:) = zsprecip(:,:) 1846 !!$ tprecip(:,:) = ztprecip(:,:) 1847 !!$ ENDIF 1848 ! 1822 1849 ! outputs 1823 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff1824 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf1825 1850 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1826 1851 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs … … 1833 1858 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1834 1859 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1835 & - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1860 & - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1836 1861 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1837 ! 1862 !!IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1863 !!IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1864 ! 1865 ! ! ================================= ! 1866 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and conductive flux ! 1867 ! ! ================================= ! 1868 CASE ('coupled') 1869 IF (ln_scale_ice_flux) THEN 1870 WHERE( a_i(:,:,:) > 1.e-10_wp ) 1871 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1872 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1873 ELSEWHERE 1874 qml_ice(:,:,:) = 0.0_wp 1875 qcn_ice(:,:,:) = 0.0_wp 1876 END WHERE 1877 ELSE 1878 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 1879 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 1880 ENDIF 1881 END SELECT 1838 1882 ! ! ========================= ! 1839 1883 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1840 1884 ! ! ========================= ! 1841 1885 CASE( 'oce only' ) ! the required field is directly provided 1842 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1843 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1844 ! here so the only flux is the ocean only one. 1845 zqns_ice(:,:,:) = 0._wp 1886 ! Get the sea ice non solar heat flux from conductive, melting and sublimation fluxes 1887 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 1888 zqns_ice(:,:,:) = qml_ice(:,:,:) + qcn_ice(:,:,:) 1889 ELSE 1890 zqns_ice(:,:,:) = 0._wp 1891 ENDIF 1892 ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE 1893 ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) 1894 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) 1846 1895 CASE( 'conservative' ) ! the required fields are directly provided 1847 1896 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1890 1939 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1891 1940 1892 #if defined key_si31893 1941 ! --- non solar flux over ocean --- ! 1894 1942 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax … … 1943 1991 ENDIF 1944 1992 1945 #else 1946 zcptsnw (:,:) = zcptn(:,:) 1947 zcptrain(:,:) = zcptn(:,:)1948 1949 ! clem: this formulation is certainly wrong... but better than it was... 1950 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1951 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 1952 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1953 & - zemp_ice(:,:) ) * zcptn(:,:) 1954 1955 IF( ln_mixcpl ) THEN 1956 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1957 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1958 DO jl=1,jpl 1959 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1960 ENDDO 1961 ELSE 1962 qns_tot(:,: ) = zqns_tot(:,: ) 1963 qns_ice(:,:,:) = zqns_ice(:,:,:)1964 ENDIF 1965 1966 #endif 1993 !! for CICE ?? 1994 !!$ ! --- non solar flux over ocean --- ! 1995 !!$ zcptsnw (:,:) = zcptn(:,:) 1996 !!$ zcptrain(:,:) = zcptn(:,:) 1997 !!$ 1998 !!$ ! clem: this formulation is certainly wrong... but better than it was... 1999 !!$ zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2000 !!$ & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2001 !!$ & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2002 !!$ & - zemp_ice(:,:) ) * zcptn(:,:) 2003 !!$ 2004 !!$ IF( ln_mixcpl ) THEN 2005 !!$ qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2006 !!$ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2007 !!$ DO jl=1,jpl 2008 !!$ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2009 !!$ ENDDO 2010 !!$ ELSE 2011 !!$ qns_tot(:,: ) = zqns_tot(:,: ) 2012 !!$ qns_ice(:,:,:) = zqns_ice(:,:,:) 2013 !!$ ENDIF 2014 !!$ 1967 2015 ! outputs 1968 2016 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving … … 1985 2033 ! 1986 2034 ! ! ========================= ! 2035 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 2036 ! ! ========================= ! 2037 CASE ('coupled') 2038 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2039 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2040 ELSE 2041 ! Set all category values equal for the moment 2042 DO jl=1,jpl 2043 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 2044 ENDDO 2045 ENDIF 2046 CASE( 'none' ) 2047 zdqns_ice(:,:,:) = 0._wp 2048 END SELECT 2049 2050 IF( ln_mixcpl ) THEN 2051 DO jl=1,jpl 2052 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 2053 ENDDO 2054 ELSE 2055 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 2056 ENDIF 2057 ! 2058 ! ! ========================= ! 1987 2059 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 1988 2060 ! ! ========================= ! 1989 2061 CASE( 'oce only' ) 1990 2062 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1991 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero1992 ! here so the only flux is the ocean only one.2063 ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice 2064 ! further down. Therefore start zqsr_ice off at zero. 1993 2065 zqsr_ice(:,:,:) = 0._wp 1994 2066 CASE( 'conservative' ) … … 2043 2115 END DO 2044 2116 ENDIF 2045 2046 #if defined key_si32047 ! --- solar flux over ocean --- !2048 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax2049 zqsr_oce = 0._wp2050 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)2051 2052 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)2053 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF2054 #endif2055 2056 IF( ln_mixcpl ) THEN2057 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2058 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)2059 DO jl = 1, jpl2060 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)2061 END DO2062 ELSE2063 qsr_tot(:,: ) = zqsr_tot(:,: )2064 qsr_ice(:,:,:) = zqsr_ice(:,:,:)2065 ENDIF2066 2067 ! ! ========================= !2068 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !2069 ! ! ========================= !2070 CASE ('coupled')2071 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN2072 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)2073 ELSE2074 ! Set all category values equal for the moment2075 DO jl=1,jpl2076 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)2077 ENDDO2078 ENDIF2079 CASE( 'none' )2080 zdqns_ice(:,:,:) = 0._wp2081 END SELECT2082 2083 IF( ln_mixcpl ) THEN2084 DO jl=1,jpl2085 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)2086 ENDDO2087 ELSE2088 dqns_ice(:,:,:) = zdqns_ice(:,:,:)2089 ENDIF2090 2091 #if defined key_si32092 ! ! ========================= !2093 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !2094 ! ! ========================= !2095 CASE ('coupled')2096 IF (ln_scale_ice_flux) THEN2097 WHERE( a_i(:,:,:) > 1.e-10_wp )2098 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2099 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2100 ELSEWHERE2101 qml_ice(:,:,:) = 0.0_wp2102 qcn_ice(:,:,:) = 0.0_wp2103 END WHERE2104 ELSE2105 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)2106 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)2107 ENDIF2108 END SELECT2109 2117 ! ! ========================= ! 2110 2118 ! ! Transmitted Qsr ! [W/m2] … … 2138 2146 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2139 2147 ! 2140 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2141 ! for now just assume zero (fully opaque ice) 2142 zqtr_ice_top(:,:,:) = 0._wp 2148 !! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) ) 2149 !! ! 2150 !! ! ! ===> here we receive the qtr_ice_top array from the coupler 2151 !! CASE ('coupled') 2152 !! IF (ln_scale_ice_flux) THEN 2153 !! WHERE( a_i(:,:,:) > 1.e-10_wp ) 2154 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2155 !! ELSEWHERE 2156 !! zqtr_ice_top(:,:,:) = 0.0_wp 2157 !! ENDWHERE 2158 !! ELSE 2159 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) 2160 !! ENDIF 2161 !! 2162 !! ! Add retrieved transmitted solar radiation onto the ice and total solar radiation 2163 !! zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) 2164 !! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) 2165 !! 2166 !! ! if we are not getting this data from the coupler then assume zero (fully opaque ice) 2167 !! CASE ('none') 2168 zqtr_ice_top(:,:,:) = 0._wp 2169 !! END SELECT 2143 2170 ! 2144 2171 ENDIF 2145 2172 ! 2146 2173 IF( ln_mixcpl ) THEN 2147 DO jl=1,jpl 2174 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2175 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:) 2176 DO jl = 1, jpl 2177 qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:) 2148 2178 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2149 END DO2179 END DO 2150 2180 ELSE 2181 qsr_tot (:,: ) = zqsr_tot (:,: ) 2182 qsr_ice (:,:,:) = zqsr_ice (:,:,:) 2151 2183 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2152 2184 ENDIF 2185 2186 ! --- solar flux over ocean --- ! 2187 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 2188 zqsr_oce = 0._wp 2189 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 2190 2191 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 2192 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 2193 2153 2194 ! ! ================== ! 2154 2195 ! ! ice skin temp. ! -
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/SBC/sbcice_cice.F90
r11536 r14590 133 133 CALL cice_sbc_force(kt) 134 134 ELSE IF ( ksbc == jp_purecpl ) THEN 135 CALL sbc_cpl_ice_flx( fr_i )135 CALL sbc_cpl_ice_flx( kt, fr_i ) 136 136 ENDIF 137 137
Note: See TracChangeset
for help on using the changeset viewer.
