Changeset 11916


Ignore:
Timestamp:
2019-11-15T16:44:47+01:00 (2 months ago)
Author:
dancopsey
Message:

Merged in all the changes in NEMO4.0_fix_cpl_oce_only (up to revison 11832)

Location:
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/cfgs/SHARED/field_def_nemo-ice.xml

    r11575 r11916  
    158158          <field id="hfxcndtop"    long_name="Net conductive heat flux at the ice surface (neg = ice cooling)"  standard_name="conductive_heat_flux_at_sea_ice_surface"    unit="W/m2" />  
    159159          <field id="hfxcndbot"    long_name="Net conductive heat flux at the ice bottom (neg = ice cooling)"   standard_name="conductive_heat_flux_at_sea_ice_bottom"     unit="W/m2" /> 
     160          <field id="hfxcndcpl"    long_name="Conductive heat flux coming through the coupler"                  standard_name="conductive_heat_flux_from_coupler"          unit="W/m2" /> 
    160161 
    161162          <!-- diags --> 
     
    245246     <field id="iceconc_cat"  long_name="Sea-ice concentration per category"                unit=""        /> 
    246247          <field id="icethic_cat"  long_name="Sea-ice thickness per category"                    unit="m"       detect_missing_value="true" /> 
     248          <field id="icevol_cat"   long_name="Sea-ice volume per category"                       unit="m"       detect_missing_value="true" /> 
    247249          <field id="snwthic_cat"  long_name="Snow thickness per category"                       unit="m"       detect_missing_value="true" /> 
    248250          <field id="icesalt_cat"  long_name="Sea-Ice Bulk salinity per category"                unit="g/kg"    detect_missing_value="true" /> 
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/ice.F90

    r11715 r11916  
    295295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness                           (m) 
    296296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
     297   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple    !: Ice fractional area at last coupling time 
    297298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area                (m) 
    298299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area               (m) 
     
    435436 
    436437      ii = ii + 1 
     438      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(ii) ) 
     439 
     440      ii = ii + 1 
    437441      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) ,                                   & 
    438442         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  & 
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icethd_zdf_bl99.F90

    r11715 r11916  
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    33    !! $Id$ 
     33   !! $Id: icethd_zdf_bl99.F90 10926 2019-05-03 12:32:10Z clem $ 
    3434   !! Software governed by the CeCILL license (see ./LICENSE) 
    3535   !!---------------------------------------------------------------------- 
     
    8989      REAL(wp) ::   zg1       =  2._wp        ! 
    9090      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat 
    91       REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
     91      REAL(wp) ::   zbeta     =  0.13_wp     ! for thermal conductivity (could be 0.13) 
    9292      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow 
    9393      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     
    769769      ! 
    770770      ! --- calculate conduction fluxes (positive downward) 
    771  
     771      !     bottom ice conduction flux 
    772772      DO ji = 1, npti 
    773          !                                ! surface ice conduction flux 
    774          qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0)      * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  & 
    775             &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0)      * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
    776          !                                ! bottom ice conduction flux 
    777          qcn_ice_bot_1d(ji) =                          - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
     773         qcn_ice_bot_1d(ji) =  - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
    778774      END DO 
    779        
     775      !     surface ice conduction flux 
     776      IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN 
     777         ! 
     778         DO ji = 1, npti 
     779            qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  & 
     780               &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
     781         END DO 
     782         ! 
     783      ELSEIF( k_cnd == np_cnd_ON ) THEN 
     784         ! 
     785         DO ji = 1, npti 
     786            qcn_ice_top_1d(ji) = qcn_ice_1d(ji) 
     787            ! 
     788            t_su_1d(ji) = (  qcn_ice_top_1d(ji) &            ! calculate surface temperature 
     789               &           +           isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) & 
     790               &           + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) & 
     791               &          ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 
     792            t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp )  ! cap t_su 
     793         END DO 
     794         ! 
     795      ENDIF 
    780796      ! 
    781797      ! --- Diagnose the heat loss due to changing non-solar / conduction flux --- ! 
     
    785801         DO ji = 1, npti 
    786802            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji)  
    787          END DO 
    788          ! 
    789       ELSEIF( k_cnd == np_cnd_ON ) THEN 
    790          ! 
    791          DO ji = 1, npti 
    792             hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qcn_ice_top_1d(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji)  
    793803         END DO 
    794804         ! 
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/iceupdate.F90

    r11715 r11916  
    279279      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( 'hfxcndbot'  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
    280280      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( 'hfxcndtop'  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
     281      IF( iom_use('hfxcndcpl'  ) )   CALL iom_put( "hfxcndcpl"  , SUM( qcn_ice * a_i_b, dim=3 ) )       ! Conduction flux we are giving it 
    281282 
    282283      ! controls 
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icewri.F90

    r11715 r11916  
    152152      IF( iom_use('iceconc_cat' ) )   CALL iom_put( 'iceconc_cat' , a_i            * zmsk00l                                   ) ! area for categories 
    153153      IF( iom_use('icethic_cat' ) )   CALL iom_put( 'icethic_cat' , h_i            * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories 
     154      IF( iom_use('icevol_cat'  ) )   CALL iom_put( "icevol_cat"  , v_i            * zmsk00l                                   ) ! volume for categories 
    154155      IF( iom_use('snwthic_cat' ) )   CALL iom_put( 'snwthic_cat' , h_s            * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories 
    155156      IF( iom_use('icesalt_cat' ) )   CALL iom_put( 'icesalt_cat' , s_i            * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories 
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/OCE/SBC/sbc_ice.F90

    r11715 r11916  
    9393    
    9494   ! already defined in ice.F90 for SI3 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i               ! Sea ice fraction on categories 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i_last_couple   ! Sea ice fraction on categories at the last coupling point 
    9697   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
    9798 
  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/OCE/SBC/sbccpl.F90

    r11715 r11916  
    4848   USE lib_mpp        ! distribued memory computing library 
    4949   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     50 
     51#if defined key_oasis3  
     52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut  
     53#endif  
    5054 
    5155   IMPLICIT NONE 
     
    152156   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level  
    153157   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 
    154    INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area 
     158   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction 
    155159   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness 
    156160   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity 
     
    159163 
    160164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
     165 
     166#if ! defined key_oasis3  
     167   ! Dummy variables to enable compilation when oasis3 is not being used  
     168   INTEGER                    ::   OASIS_Sent        = -1  
     169   INTEGER                    ::   OASIS_SentOut     = -1  
     170   INTEGER                    ::   OASIS_ToRest      = -1  
     171   INTEGER                    ::   OASIS_ToRestOut   = -1  
     172#endif  
    161173 
    162174   !                                  !!** namelist namsbc_cpl ** 
     
    184196   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    185197                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     198   LOGICAL     ::   ln_scale_ice_fluxes   ! Scale sea ice fluxes by the sea ice fractions at the previous coupling point 
    186199   TYPE ::   DYNARR      
    187200      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
     
    256269         &                  sn_rcv_iceflx, sn_rcv_co2   , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,   & 
    257270         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl  ,   & 
    258          &                  sn_rcv_ts_ice 
     271         &                  sn_rcv_ts_ice, ln_scale_ice_fluxes 
    259272 
    260273      !!--------------------------------------------------------------------- 
     
    330343         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    331344         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
     345         WRITE(numout,*)'  ln_scale_ice_fluxes                 = ', ln_scale_ice_fluxes 
    332346      ENDIF 
    333347 
     
    815829      END SELECT 
    816830 
     831      ! Initialise ice fractions from last coupling time to zero 
     832       a_i_last_couple(:,:,:) = 0._wp 
     833 
     834 
    817835      !                                                      ! ------------------------- !  
    818836      !                                                      !      Ice Meltponds        !  
     
    16431661      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
    16441662      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     1663      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total 
    16451664      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice    !!gm , zfrqsr_tr_i 
    16461665      !!---------------------------------------------------------------------- 
     
    16631682         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16641683         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1665          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16661684      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    16671685         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    16681686         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 
    16691687         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    1670          ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
     1688         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)          
    16711689      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce  
    16721690      !                         ! since fields received are not defined with none option 
     
    16751693 
    16761694#if defined key_si3 
     1695 
     1696      ! --- evaporation over ice (kg/m2/s) --- ! 
     1697      zevap_ice_total(:,:) = 0._wp    
     1698      IF (sn_rcv_emp%clcat == 'yes') THEN 
     1699         DO jl=1,jpl 
     1700            IF (ln_scale_ice_fluxes) THEN 
     1701               zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) * a_i_last_couple(:,:,jl) 
     1702            ELSE 
     1703               zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
     1704            ENDIF 
     1705            zevap_ice_total(:,:) = zevap_ice_total(:,:) + zevap_ice(:,:,jl) 
     1706         ENDDO 
     1707      ELSE 
     1708         zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1 ) 
     1709         zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1710      ENDIF 
     1711 
     1712      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 
     1713         ! For conservative case zemp_ice has not been defined yet. Do it now. 
     1714         zemp_ice(:,:) = zevap_ice_total(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 
     1715      END IF 
     1716 
    16771717      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    16781718      zsnw(:,:) = 0._wp   ;   CALL ice_thd_snwblow( ziceld, zsnw ) 
     
    16831723 
    16841724      ! --- evaporation over ocean (used later for qemp) --- ! 
    1685       zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 
    1686  
    1687       ! --- evaporation over ice (kg/m2/s) --- ! 
    1688       DO jl=1,jpl 
    1689          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    1690          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    1691       ENDDO 
     1725      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) 
     1726 
     1727       
     1728 
    16921729 
    16931730      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     
    17271764         sprecip (:,:)   = zsprecip (:,:) 
    17281765         tprecip (:,:)   = ztprecip (:,:) 
    1729          evap_ice(:,:,:) = zevap_ice(:,:,:) 
     1766         IF (ln_scale_ice_fluxes) THEN 
     1767            ! Convert from grid box means to sea ice means 
     1768            WHERE( a_i(:,:,:) > 0.0_wp ) evap_ice(:,:,:) = zevap_ice(:,:,:) / a_i(:,:,:) 
     1769            WHERE( a_i(:,:,:) <= 0.0_wp ) evap_ice(:,:,:) = 0.0 
     1770         ELSE 
     1771            evap_ice(:,:,:) = zevap_ice(:,:,:) 
     1772         ENDIF 
    17301773         DO jl = 1, jpl 
    17311774            devap_ice(:,:,jl) = zdevap_ice(:,:) 
     
    17741817      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    17751818      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    1776       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) 
     1819      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
    17771820      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
    1778          &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
     1821         &                                                        - zevap_ice_total(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
    17791822      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 
    17801823      ! 
     
    17841827      CASE( 'oce only' )         ! the required field is directly provided 
    17851828         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1829         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
     1830         ! here so the only flux is the ocean only one. 
     1831         zqns_ice(:,:,:) = 0._wp  
    17861832      CASE( 'conservative' )     ! the required fields are directly provided 
    17871833         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     
    18471893         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )  ! solid precip over ocean + snow melting 
    18481894      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )  ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
    1849 !!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    1850 !!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice 
    18511895       
    18521896      ! --- total non solar flux (including evap/precip) --- ! 
     
    19001944      IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
    19011945      IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
    1902       IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
    1903            &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
     1946      IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:)  ) & 
     1947                                                                         * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
    19041948      IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
    19051949      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
     
    19141958      CASE( 'oce only' ) 
    19151959         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1960         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 
     1961         ! here so the only flux is the ocean only one. 
     1962         zqsr_ice(:,:,:) = 0._wp 
    19161963      CASE( 'conservative' ) 
    19171964         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     
    19922039            ENDDO 
    19932040         ENDIF 
     2041      CASE( 'none'      )  
     2042         zdqns_ice(:,:,:) = 0._wp 
    19942043      END SELECT 
    19952044       
     
    20072056      !                                                      ! ========================= ! 
    20082057      CASE ('coupled') 
    2009          qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
    2010          qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2058         IF (ln_scale_ice_fluxes) THEN 
     2059            WHERE( a_i(:,:,:) > 0.0_wp ) qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2060            WHERE( a_i(:,:,:) <= 0.0_wp ) qml_ice(:,:,:) = 0.0_wp 
     2061            WHERE( a_i(:,:,:) > 0.0_wp ) qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2062            WHERE( a_i(:,:,:) <= 0.0_wp ) qcn_ice(:,:,:) = 0.0_wp 
     2063         ELSE 
     2064            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
     2065            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2066         ENDIF 
    20112067      END SELECT 
    20122068      ! 
     
    21932249      ENDIF 
    21942250 
     2251      ! If this coupling was successful then save ice fraction for use between coupling points.  
     2252      ! This is needed for some calculations where the ice fraction at the last coupling point  
     2253      ! is needed.  
     2254      IF( info == OASIS_Sent     .OR. info == OASIS_ToRest .OR.   &  
     2255                     & info == OASIS_SentOut  .OR. info == OASIS_ToRestOut ) THEN  
     2256         IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2257           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
     2258         ENDIF 
     2259      ENDIF     
     2260 
    21952261      IF( ssnd(jps_fice1)%laction ) THEN 
    21962262         SELECT CASE( sn_snd_thick1%clcat ) 
     
    22502316      !                                                      !      Ice melt ponds       !  
    22512317      !                                                      ! ------------------------- ! 
    2252       ! needed by Met Office 
     2318      ! needed by Met Office - 1) fraction of ponded ice; 2) local/actual pond depth 
    22532319      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN  
    22542320         SELECT CASE( sn_snd_mpnd%cldes)   
     
    22562322            SELECT CASE( sn_snd_mpnd%clcat )   
    22572323            CASE( 'yes' )   
    2258                ztmp3(:,:,1:jpl) =  a_ip(:,:,1:jpl) 
    2259                ztmp4(:,:,1:jpl) =  v_ip(:,:,1:jpl)   
     2324               ztmp3(:,:,1:jpl) =  a_ip_frac(:,:,1:jpl) 
     2325               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
    22602326            CASE( 'no' )   
    22612327               ztmp3(:,:,:) = 0.0   
    22622328               ztmp4(:,:,:) = 0.0   
    22632329               DO jl=1,jpl   
    2264                  ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl)   
    2265                  ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)  
     2330                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
     2331                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    22662332               ENDDO   
    22672333            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )   
Note: See TracChangeset for help on using the changeset viewer.