Changeset 12733


Ignore:
Timestamp:
2020-04-10T13:07:50+02:00 (7 months ago)
Author:
clem
Message:

change sbccpl.F90 to fulfill Met-Office requirements (hopefully)

Location:
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/cfgs/SHARED/namelist_ref

    r12720 r12733  
    286286&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    287287!----------------------------------------------------------------------- 
    288    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
    289    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models 
    290    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    291    nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
     288   nn_cplmodel       =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
     289   ln_usecplmask     = .false. !  use a coupling mask file to merge data received from several models 
     290   !                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     291   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     292   nn_cats_cpl       =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    292293   !_____________!__________________________!____________!_____________!______________________!________! 
    293294   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/doc/namelists/namsbc_cpl

    r10075 r12733  
    22&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    33!----------------------------------------------------------------------- 
    4    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
    5    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models 
    6    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    7    nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    8  
     4   nn_cplmodel       =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
     5   ln_usecplmask     = .false. !  use a coupling mask file to merge data received from several models 
     6   !                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     7   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     8   nn_cats_cpl       =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    99   !_____________!__________________________!____________!_____________!______________________!________! 
    1010   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/ice.F90

    r12726 r12733  
    398398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top   !: Surface conduction flux (W/m2) 
    399399 
     400   !!---------------------------------------------------------------------- 
     401   !! * Only for atmospheric coupling 
     402   !!---------------------------------------------------------------------- 
     403   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple !: Ice fractional area at last coupling time 
    400404   ! 
    401405   !!---------------------------------------------------------------------- 
     
    412416      INTEGER :: ice_alloc 
    413417      ! 
    414       INTEGER :: ierr(16), ii 
     418      INTEGER :: ierr(17), ii 
    415419      !!----------------------------------------------------------------- 
    416420      ierr(:) = 0 
     
    494498      ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    495499 
     500      ! * For atmospheric coupling 
     501      ii = ii + 1 
     502      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(ii) ) 
     503 
    496504      ice_alloc = MAXVAL( ierr(:) ) 
    497505      IF( ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) 
    498506      ! 
     507 
    499508   END FUNCTION ice_alloc 
    500509 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbc_ice.F90

    r12395 r12733  
    8989   ! variables used in the coupled interface 
    9090   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    91    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice  
    9292    
    9393   ! already defined in ice.F90 for SI3 
    9494   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    9595   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i_last_couple   !: Sea ice fraction on categories at the last coupling point 
    9697 
    9798   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90

    r12725 r12733  
    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_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)  
     199 
    186200   TYPE ::   DYNARR      
    187201      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
     
    248262      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos 
    249263      !! 
    250       NAMELIST/namsbc_cpl/  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2  ,   &  
     264      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             & 
     265         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  &  
    251266         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  &  
    252          &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc,   &  
    253          &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr  ,   &  
     267         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  &  
     268         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
    254269         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
    255          &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal  ,   & 
    256          &                  sn_rcv_iceflx, sn_rcv_co2   , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,   & 
    257          &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl  ,   & 
     270         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
     271         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
     272         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 & 
    258273         &                  sn_rcv_ts_ice 
    259  
    260274      !!--------------------------------------------------------------------- 
    261275      ! 
     
    279293      ENDIF 
    280294      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
     295         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     296         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
     297         WRITE(numout,*)'  ln_scale_ice_flux                   = ', ln_scale_ice_flux 
     298         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
    281299         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    282300         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     
    327345         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    328346         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
    329          WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    330          WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    331          WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
    332347      ENDIF 
    333348 
     
    821836      END SELECT 
    822837 
     838      ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 
     839       a_i_last_couple(:,:,:) = 0._wp 
     840 
    823841      !                                                      ! ------------------------- !  
    824842      !                                                      !      Ice Meltponds        !  
     
    16391657      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
    16401658      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     1659      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total 
    16411660      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 
    16421661      !!---------------------------------------------------------------------- 
     
    16591678         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16601679         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1661          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16621680      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    16631681         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     
    16711689 
    16721690#if defined key_si3 
     1691 
     1692      ! --- evaporation over ice (kg/m2/s) --- ! 
     1693      IF (ln_scale_ice_flux) THEN ! typically met-office requirements 
     1694         IF (sn_rcv_emp%clcat == 'yes') THEN 
     1695            WHERE( a_i(:,:,:) > 1.e-10) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     1696            ELSEWHERE                   ; zevap_ice(:,:,:) = 0._wp 
     1697            END WHERE 
     1698            zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:), dim=3 ) 
     1699         ELSE 
     1700            WHERE( picefr(:,:) > 1.e-10) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 
     1701            ELSEWHERE                    ; zevap_ice(:,:,1) = 0._wp 
     1702            END WHERE 
     1703            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1704         ENDIF 
     1705      ELSE 
     1706         IF (sn_rcv_emp%clcat == 'yes') THEN 
     1707            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 
     1708            zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:), dim=3 ) 
     1709         ELSE 
     1710            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 
     1711            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1712         ENDIF 
     1713      ENDIF 
     1714 
     1715      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 
     1716         ! For conservative case zemp_ice has not been defined yet. Do it now. 
     1717         zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 
     1718      ENDIF 
     1719 
    16731720      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    16741721      zsnw(:,:) = 0._wp   ;   CALL ice_thd_snwblow( ziceld, zsnw ) 
     
    16791726 
    16801727      ! --- evaporation over ocean (used later for qemp) --- ! 
    1681       zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 
    1682  
    1683       ! --- evaporation over ice (kg/m2/s) --- ! 
    1684       DO jl=1,jpl 
    1685          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    1686          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    1687       ENDDO 
     1728      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 
    16881729 
    16891730      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     
    17631804!!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff 
    17641805!!      IF( srcv(jpr_isf)%laction )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1)                         )  ! iceshelf 
    1765       IF( srcv(jpr_cal)%laction )   CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving 
    1766       IF( srcv(jpr_icb)%laction )   CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs 
    1767       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow 
    1768       CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation 
    1769       IF ( iom_use('rain') ) CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation  
    1770       IF ( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    1771       IF ( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    1772       IF ( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average) 
    1773       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) 
    1774       IF ( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
    1775          &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 
     1806      IF( srcv(jpr_cal)%laction )    CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving 
     1807      IF( srcv(jpr_icb)%laction )    CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs 
     1808      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow 
     1809      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation 
     1810      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation  
     1811      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
     1812      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
     1813      IF( iom_use('rain_ao_cea') )  CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average) 
     1814      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) 
     1815      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
     1816         &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 
    17761817      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 
    17771818      ! 
     
    17811822      CASE( 'oce only' )         ! the required field is directly provided 
    17821823         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1824         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
     1825         ! here so the only flux is the ocean only one. 
     1826         zqns_ice(:,:,:) = 0._wp  
    17831827      CASE( 'conservative' )     ! the required fields are directly provided 
    17841828         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     
    18111855               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl)    & 
    18121856                  &             + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   & 
    1813                   &                                                                + pist(:,:,jl) * picefr(:,:) ) ) 
     1857                  &                                             + pist(:,:,jl) * picefr(:,:) ) ) 
    18141858            END DO 
    18151859         ELSE 
     
    18171861               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1)    & 
    18181862                  &             + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   & 
    1819                   &                                                                + pist(:,:,jl) * picefr(:,:) ) ) 
     1863                  &                                             + pist(:,:,jl) * picefr(:,:) ) ) 
    18201864            END DO 
    18211865         ENDIF 
     
    19211965      CASE( 'oce only' ) 
    19221966         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1967         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 
     1968         ! here so the only flux is the ocean only one. 
     1969         zqsr_ice(:,:,:) = 0._wp 
    19231970      CASE( 'conservative' ) 
    19241971         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     
    20072054            ENDDO 
    20082055         ENDIF 
     2056      CASE( 'none' )  
     2057         zdqns_ice(:,:,:) = 0._wp 
    20092058      END SELECT 
    20102059       
     
    20222071      !                                                      ! ========================= ! 
    20232072      CASE ('coupled') 
    2024          IF( ln_mixcpl ) THEN 
    2025             DO jl=1,jpl 
    2026                qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 
    2027                qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 
    2028             ENDDO 
     2073         IF (ln_scale_ice_flux) THEN 
     2074            WHERE( a_i(:,:,:) > 1.e-10_wp ) 
     2075               qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2076               qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2077            ELSEWHERE 
     2078               qml_ice(:,:,:) = 0.0_wp 
     2079               qcn_ice(:,:,:) = 0.0_wp 
     2080            END WHERE 
    20292081         ELSE 
    20302082            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
     
    22452297      ENDIF 
    22462298 
     2299      ! If this coupling was successful then save ice fraction for use between coupling points.  
     2300      ! This is needed for some calculations where the ice fraction at the last coupling point  
     2301      ! is needed.  
     2302      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. &  
     2303         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN  
     2304         IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2305           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
     2306         ENDIF 
     2307      ENDIF 
     2308 
    22472309      IF( ssnd(jps_fice1)%laction ) THEN 
    22482310         SELECT CASE( sn_snd_thick1%clcat ) 
     
    23142376               ztmp4(:,:,:) = 0.0   
    23152377               DO jl=1,jpl   
    2316                  ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_eff(:,:,jpl)   
    2317                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)  
     2378                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
     2379                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    23182380               ENDDO   
    23192381            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.