Changeset 5407


Ignore:
Timestamp:
2015-06-11T21:13:22+02:00 (5 years ago)
Author:
smasson
Message:

merge dev_r5218_CNRS17_coupling into the trunk

Location:
trunk/NEMOGCM
Files:
1 added
64 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/ARCH/arch-X64_CURIE.fcm

    r4865 r5407  
    2929#  - fcm variables are starting with a % (and not a $) 
    3030# 
    31 %NCDF_HOME           /usr/local/netcdf-4.2_hdf5_parallel 
    32 %HDF5_HOME           /usr/local/hdf5-1.8.9_parallel 
    33 %XIOS_HOME           $WORKDIR/now/models/xios 
     31%NCDF_HOME            /usr/local/netcdf-4.3.3.1_hdf5_parallel 
     32%HDF5_HOME           /usr/local/hdf5-1.8.12_parallel 
     33%XIOS_HOME           $WORKDIR/xios-1.0 
    3434%OASIS_HOME          $WORKDIR/now/models/oa3mct 
    3535 
  • trunk/NEMOGCM/ARCH/arch-macport_osx.fcm

    r4865 r5407  
    4040%NCDF_HOME           /opt/local 
    4141%HDF5_HOME           /opt/local 
    42 %XIOS_HOME           /Users/$( whoami )/XIOS 
     42%XIOS_HOME           /Users/$( whoami )/xios-1.0 
    4343%OASIS_HOME          /not/defined 
    4444 
  • trunk/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r5147 r5407  
    129129/ 
    130130!----------------------------------------------------------------------- 
    131 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     131&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    132132!----------------------------------------------------------------------- 
    133133/ 
  • trunk/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r5108 r5407  
    131131/ 
    132132!----------------------------------------------------------------------- 
    133 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     133&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    134134!----------------------------------------------------------------------- 
    135135/ 
  • trunk/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg

    r5102 r5407  
    116116/ 
    117117!----------------------------------------------------------------------- 
    118 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     118&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    119119!----------------------------------------------------------------------- 
    120120/ 
  • trunk/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r5102 r5407  
    121121/ 
    122122!----------------------------------------------------------------------- 
    123 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     123&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    124124!----------------------------------------------------------------------- 
    125125/ 
  • trunk/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg

    r5300 r5407  
    110110/ 
    111111!----------------------------------------------------------------------- 
    112 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     112&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    113113!----------------------------------------------------------------------- 
    114114/ 
  • trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml

    r5385 r5407  
    7373   <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 
    7474     <field field_ref="e3w"                        /> 
    75      <field field_ref="woce"         name="wo"      operation="instant" freq_op="5d" > @woce_e3w / @e3w </field> 
     75     <field field_ref="woce"         name="wo"     /> 
    7676     <field field_ref="avt"          name="difvho" /> 
    7777   </file> 
  • trunk/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r5385 r5407  
    102102   <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 
    103103     <field field_ref="e3w" /> 
    104      <field field_ref="woce"         name="wo"       operation="instant" freq_op="5d" > @woce_e3w / @e3w </field> 
     104     <field field_ref="woce"         name="wo"       /> 
    105105     <field field_ref="avt"          name="difvho"   /> 
    106106     <field field_ref="w_masstr"     name="vovematr" /> 
  • trunk/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg

    r4147 r5407  
    110110!!   namsbc_clio     CLIO bulk formulea formulation 
    111111!!   namsbc_core     CORE bulk formulea formulation 
    112 !!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
     112!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3") 
    113113!!   namtra_qsr      penetrative solar radiation 
    114114!!   namsbc_rnf      river runoffs 
     
    199199/ 
    200200!----------------------------------------------------------------------- 
    201 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     201&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    202202!----------------------------------------------------------------------- 
    203203!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     
    640640                           !        = 1 add a tke source below the ML 
    641641                           !        = 2 add a tke source just at the base of the ML 
    642                            !        = 3 as = 1 applied on HF part of the stress    ("key_coupled") 
     642                           !        = 3 as = 1 applied on HF part of the stress    ("key_oasis3") 
    643643   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 
    644644   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML 
  • trunk/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg

    r4370 r5407  
    104104/ 
    105105!----------------------------------------------------------------------- 
    106 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     106&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    107107!----------------------------------------------------------------------- 
    108108/ 
  • trunk/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5385 r5407  
    202202         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"  standard_name="surface_downward_sensible_heat_flux"  unit="W/m2"  /> 
    203203         <field id="qla_oce"      long_name="Latent Downward Heat Flux over open ocean"    standard_name="surface_downward_latent_heat_flux"    unit="W/m2"  /> 
    204          <field id="qhc_oce"      long_name="Downward Heat Flux from E-P over open ocean"                                                       unit="W/m2"  /> 
     204         <field id="qemp_oce"     long_name="Downward Heat Flux from E-P over open ocean"                                                       unit="W/m2"  /> 
    205205         <field id="taum_oce"     long_name="wind stress module over open ocean"           standard_name="magnitude_of_surface_downward_stress" unit="N/m2"  /> 
    206206 
    207          <!-- available key_coupled --> 
     207         <!-- available key_oasis3 --> 
    208208         <field id="snow_ao_cea"  long_name="Snow over ice-free ocean (cell average)"   standard_name="snowfall_flux"                             unit="kg/m2/s"  /> 
    209209         <field id="snow_ai_cea"  long_name="Snow over sea-ice (cell average)"          standard_name="snowfall_flux"                             unit="kg/m2/s"  /> 
     
    212212         <field id="calving_cea"  long_name="Calving"                                   standard_name="water_flux_into_sea_water_from_icebergs"   unit="kg/m2/s"  /> 
    213213 
    214          <!-- available if key_coupled + conservative method --> 
     214         <!-- available if key_oasis3 + conservative method --> 
    215215         <field id="rain"          long_name="Liquid precipitation"                                     standard_name="rainfall_flux"                                                                 unit="kg/m2/s"  /> 
    216216         <field id="evap_ao_cea"   long_name="Evaporation over ice-free ocean (cell average)"           standard_name="water_evaporation_flux"                                                        unit="kg/m2/s"  /> 
     
    269269         <field id="qns_ice"      long_name="non-solar heat flux at ice surface: sum over categories"                                                                         unit="W/m2"         /> 
    270270         <field id="qtr_ice"      long_name="solar heat flux transmitted through ice: sum over categories"                                                                    unit="W/m2"         /> 
     271         <field id="qemp_ice"     long_name="Downward Heat Flux from E-P over ice"                                                                                            unit="W/m2"         /> 
    271272         <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         /> 
    272273         <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        /> 
     
    345346         <field id="hfxdhc"       long_name="Heat content variation in snow and ice"                       unit="W/m2" /> 
    346347         <field id="hfxtur"       long_name="turbulent heat flux at the ice base"                          unit="W/m2" /> 
     348    <!-- sbcssm variables --> 
     349         <field id="sst_m"    unit="degC" /> 
     350         <field id="sss_m"    unit="psu"  /> 
     351         <field id="ssu_m"    unit="m/s"  /> 
     352         <field id="ssv_m"    unit="m/s"  /> 
     353         <field id="ssh_m"    unit="m"    /> 
     354         <field id="e3t_m"    unit="m"    /> 
     355         <field id="frq_m"    unit="-"    /> 
     356 
    347357      </field_group> 
    348358 
     
    420430        <field id="e3w"          long_name="W-cell thickness"                     standard_name="cell_thickness"              unit="m"    /> 
    421431        <field id="woce"         long_name="ocean vertical velocity"              standard_name="upward_sea_water_velocity"   unit="m/s"  /> 
    422         <field id="woce_e3w"     long_name="ocean vertical velocity * e3v"                                                    unit="m2/s"  > woce * e3w </field> 
    423432        <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                               unit="m3/s" /> 
    424433 
  • trunk/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5397 r5407  
    220220!!   namsbc_core     CORE bulk formulae formulation 
    221221!!   namsbc_mfs      MFS  bulk formulae formulation 
    222 !!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
     222!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3") 
    223223!!   namsbc_sas      StAndalone Surface module 
    224224!!   namtra_qsr      penetrative solar radiation 
     
    240240   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    241241   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
     242   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 ) 
     243   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 ) 
     244   nn_components = 0       !  configuration of the opa-sas OASIS coupling 
     245                           !  =0 no opa-sas OASIS coupling: default single executable configuration 
     246                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component 
     247                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component  
    242248   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    243249   nn_ice      = 2         !  =0 no ice boundary condition   , 
     
    347353/ 
    348354!----------------------------------------------------------------------- 
    349 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
     355&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    350356!----------------------------------------------------------------------- 
    351357!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     
    383389   sn_sal      = 'sas_grid_T' ,    120           , 'sosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
    384390   sn_ssh      = 'sas_grid_T' ,    120           , 'sossheig' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
    385  
    386    ln_3d_uv    = .true.    !  specify whether we are supplying a 3D u,v field 
     391   sn_e3t      = 'sas_grid_T' ,    120           , 'e3t_m'    ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
     392   sn_frq      = 'sas_grid_T' ,    120           , 'frq_m'    ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
     393 
     394   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field 
     395   ln_read_frq = .false.    !  specify whether we must read frq or not 
    387396   cn_dir      = './'      !  root directory for the location of the bulk files are 
    388397/ 
     
    417426 
    418427   cn_dir       = './'      !  root directory for the location of the runoff files 
    419    ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F) 
    420428   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths 
    421429   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used 
     
    949957                           !        = 1 add a tke source below the ML 
    950958                           !        = 2 add a tke source just at the base of the ML 
    951                            !        = 3 as = 1 applied on HF part of the stress    ("key_coupled") 
     959                           !        = 3 as = 1 applied on HF part of the stress    ("key_oasis3") 
    952960   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 
    953961   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML 
  • trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile

    r2528 r5407  
    2222 
    2323conv :  $(OBJS) 
    24    @$(CC) $(OBJS) -o ../$@ 
     24   @$(CC) $(OBJS) -o0 ../$@ 
    2525 
    2626main.o : main.c 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r5385 r5407  
    9696      !!              - fr_i    : ice fraction 
    9797      !!              - tn_ice  : sea-ice surface temperature 
    98       !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
     98      !!              - alb_ice : sea-ice albedo (ln_cpl=T) 
    9999      !! 
    100100      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    178178 
    179179            !   computation the solar flux at ocean surface 
    180             IF( lk_cpl ) THEN 
     180            IF( ln_cpl ) THEN 
    181181               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    182182            ELSE 
     
    202202            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
    203203            !                                                  ! coupled mode:  
    204             IF( lk_cpl ) THEN 
     204            IF( ln_cpl ) THEN 
    205205               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
    206206                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     
    252252      !-----------------------------------------------! 
    253253 
    254       IF( lk_cpl) THEN 
     254      IF( ln_cpl) THEN 
    255255         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    256256         ht_i(:,:,1) = hicif(:,:) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r5385 r5407  
    216216                         
    217217            !  partial computation of the lead energy budget (qldif) 
    218             IF( lk_cpl ) THEN  
     218            IF( ln_cpl ) THEN  
    219219               qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
    220220                  &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
     
    288288         CALL tab_2d_1d_2( nbpb,  qns_ice_1d(1:nbpb)     ,  qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    289289         CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    290          IF( .NOT. lk_cpl ) THEN  
     290         IF( .NOT. ln_cpl ) THEN  
    291291            CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     ,  qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
    292292            CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 
     
    333333         CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb)  , jpi, jpj ) 
    334334         CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb)  , jpi, jpj ) 
    335          IF( .NOT. lk_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 
     335         IF( .NOT. ln_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 
    336336         ! 
    337337      ENDIF 
     
    434434      IF( iom_use('qsr_ai_cea' ) )   CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice     [W/m2] 
    435435      IF( iom_use('qns_ai_cea' ) )   CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice [W/m2] 
    436       IF( iom_use('qla_ai_cea' ) .AND. .NOT. lk_cpl ) & 
     436      IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) & 
    437437         &                           CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )   ! Latent flux over the ice [W/m2] 
    438438      ! 
     
    557557      IF(lwm) WRITE ( numoni, namicethd ) 
    558558 
    559       IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
     559      IF( ln_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
    560560      ! 
    561561      IF(lwp) THEN                          ! control print 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r5385 r5407  
    1818   USE ice_2 
    1919   USE limistate_2 
    20    USE sbc_oce, ONLY : lk_cpl 
     20   USE sbc_oce, ONLY : ln_cpl 
    2121   USE in_out_manager 
    2222   USE lib_mpp          ! MPP library 
     
    325325       !----------------------------------------------------------------------   
    326326                      
    327        IF ( .NOT. lk_cpl ) THEN   ! duplicate the loop for performances issues 
     327       IF ( .NOT. ln_cpl ) THEN   ! duplicate the loop for performances issues 
    328328          DO ji = kideb, kiut 
    329329             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r5202 r5407  
    117117 
    118118      ! basal temperature (considered at freezing point) 
    119       t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tmask(:,:,1)  
     119      t_bo(:,:) = ( eos_fzp( sss_m(:,:) ) + rt0 ) * tmask(:,:,1)  
    120120 
    121121      IF( ln_iceini ) THEN 
     
    127127      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    128128         DO ji = 1, jpi 
    129             IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
     129            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
    130130               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    131131            ELSE                                                                                    
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r5202 r5407  
    9191      !!------------------------------------------------------------------ 
    9292 
    93       CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer 
    94       CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer 
     93      CALL wrk_alloc( jpi,jpj, zremap_flag ) 
     94      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 
    9595      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    9696      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    9797      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    9898      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    99       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     99      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    100100      CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    101101 
     
    128128               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes 
    129129               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 
    130                rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )    !0 if no ice and 1 if yes 
     130               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) 
    131131               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
    132                zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
     132               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement?  
    133133            END DO 
    134134         END DO 
     
    172172            ! 
    173173            zhbnew(ii,ij,jl) = hi_max(jl) 
    174             IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
     174            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
    175175               !interpolate between adjacent category growth rates 
    176176               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 
    177177               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 
    178             ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 
     178            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN 
    179179               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    180             ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 
     180            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN 
    181181               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    182182            ENDIF 
     
    187187            ii = nind_i(ji) 
    188188            ij = nind_j(ji) 
    189             IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
     189 
     190            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible  
     191            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     192            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN 
    190193               zremap_flag(ii,ij) = 0 
    191             ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
     194            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN 
    192195               zremap_flag(ii,ij) = 0 
    193196            ENDIF 
    194197 
    195198            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
     199            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
    196200            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
    197             IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     201            ! clem bug: why is not the following instead? 
     202            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     203            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0 
     204  
    198205         END DO 
    199206 
     
    219226      DO jj = 1, jpj 
    220227         DO ji = 1, jpi 
    221             zhb0(ji,jj) = hi_max(0) ! 0eme 
    222             zhb1(ji,jj) = hi_max(1) ! 1er 
    223  
    224             zhbnew(ji,jj,klbnd-1) = 0._wp 
     228            zhb0(ji,jj) = hi_max(0) 
     229            zhb1(ji,jj) = hi_max(1) 
    225230 
    226231            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN 
    227232               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) ) 
    228233            ELSE 
    229                zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
    230                !!? clem bug: since hi_max(jpl)=99, this limit is very high  
    231                !!? but I think it is erased in fitline subroutine  
     234!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
     235               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway 
     236            ENDIF 
     237 
     238            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible  
     239            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     240            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN 
     241               zremap_flag(ji,jj) = 0 
     242            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN 
     243               zremap_flag(ji,jj) = 0 
    232244            ENDIF 
    233245 
     
    248260 
    249261         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 
     262 
    250263            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 
    251             IF( zdh0 < 0.0 ) THEN !remove area from category 1 
     264 
     265            IF( zdh0 < 0.0 ) THEN      !remove area from category 1 
    252266               zdh0 = MIN( -zdh0, hi_max(klbnd) ) 
    253  
    254267               !Integrate g(1) from 0 to dh0 to estimate area melted 
    255268               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd) 
     269 
    256270               IF( zetamax > 0.0 ) THEN 
    257                   zx1  = zetamax 
    258                   zx2  = 0.5 * zetamax * zetamax  
    259                   zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 
    260                   ! Constrain new thickness <= ht_i 
    261                   zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! zdamax > 0 
    262                   !ice area lost due to melting of thin ice 
    263                   zda0   = MIN( zda0, zdamax ) 
    264  
     271                  zx1    = zetamax 
     272                  zx2    = 0.5 * zetamax * zetamax  
     273                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed 
     274                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                 
     275                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting  
     276                                                                                                !     of thin ice (zdamax > 0) 
    265277                  ! Remove area, conserving volume 
    266278                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 
     
    269281               ENDIF 
    270282 
    271             ELSE ! if ice accretion ! a_i > epsi10; zdh0 > 0 
     283            ELSE ! if ice accretion zdh0 > 0 
     284               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1) 
    272285               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) )  
    273                ! zhbnew was 0, and is shifted to the right to account for thin ice 
    274                ! growth in openwater (F0 = f1) 
    275             ENDIF ! zdh0  
    276  
    277          ENDIF ! a_i > epsi10 
     286            ENDIF 
     287 
     288         ENDIF 
    278289 
    279290      END DO 
     
    303314 
    304315            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 
    305  
    306316               ! left and right integration limits in eta space 
    307317               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl) 
    308                zvetamax(ji) = MIN (zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 
     318               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 
    309319               zdonor(ii,ij,jl) = jl 
    310320 
    311             ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    312  
     321            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    313322               ! left and right integration limits in eta space 
    314323               zvetamin(ji) = 0.0 
     
    316325               zdonor(ii,ij,jl) = jl + 1 
    317326 
    318             ENDIF  ! zhbnew(jl) > hi_max(jl) 
     327            ENDIF 
    319328 
    320329            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin 
     
    333342 
    334343         END DO 
    335       END DO ! jl klbnd -> kubnd - 1 
     344      END DO 
    336345 
    337346      !!---------------------------------------------------------------------------------------------- 
     
    375384      ENDIF 
    376385 
    377       CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer 
    378       CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer 
     386      CALL wrk_dealloc( jpi,jpj, zremap_flag ) 
     387      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) 
    379388      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    380389      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    381390      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    382391      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    383       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     392      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    384393      CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    385394 
     
    406415      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  ! 
    407416      ! 
    408       INTEGER ::   ji,jj           ! horizontal indices 
     417      INTEGER  ::   ji,jj        ! horizontal indices 
    409418      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL) 
    410419      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL) 
     
    413422      !!------------------------------------------------------------------ 
    414423      ! 
    415       ! 
    416424      DO jj = 1, jpj 
    417425         DO ji = 1, jpi 
    418426            ! 
    419427            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   & 
    420                &                        .AND. hice(ji,jj)        > 0._wp     ) THEN 
     428               &                        .AND. hice(ji,jj)        > 0._wp ) THEN 
    421429 
    422430               ! Initialize hL and hR 
    423  
    424431               hL(ji,jj) = HbL(ji,jj) 
    425432               hR(ji,jj) = HbR(ji,jj) 
    426433 
    427434               ! Change hL or hR if hice falls outside central third of range 
    428  
    429435               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) ) 
    430436               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) ) 
     
    435441 
    436442               ! Compute coefficients of g(eta) = g0 + g1*eta 
    437  
    438443               zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj)) 
    439444               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 
     
    442447               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 ) 
    443448               ! 
    444             ELSE                   ! remap_flag = .false. or a_i < epsi10  
     449            ELSE  ! remap_flag = .false. or a_i < epsi10  
    445450               hL(ji,jj) = 0._wp 
    446451               hR(ji,jj) = 0._wp 
    447452               g0(ji,jj) = 0._wp 
    448453               g1(ji,jj) = 0._wp 
    449             ENDIF                  ! a_i > epsi10 
     454            ENDIF 
    450455            ! 
    451456         END DO 
     
    471476 
    472477      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices 
    473       INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done 
     478      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done 
    474479 
    475480      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn 
     
    484489      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions 
    485490 
    486       INTEGER ::   nbrem             ! number of cells with ice to transfer 
    487  
    488       LOGICAL ::   zdaice_negative         ! true if daice < -puny 
    489       LOGICAL ::   zdvice_negative         ! true if dvice < -puny 
    490       LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen 
    491       LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen 
     491      INTEGER  ::   nbrem             ! number of cells with ice to transfer 
    492492      !!------------------------------------------------------------------ 
    493493 
    494494      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 
    495495      CALL wrk_alloc( jpi,jpj, zworka ) 
    496       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     496      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    497497 
    498498      !---------------------------------------------------------------------------------------------- 
     
    504504      END DO 
    505505 
    506 !clem: I think the following is wrong (if enabled, it creates negative concentration/volume around -epsi10) 
    507 !      !---------------------------------------------------------------------------------------------- 
    508 !      ! 2) Check for daice or dvice out of range, allowing for roundoff error 
    509 !      !---------------------------------------------------------------------------------------------- 
    510 !      ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl 
    511 !      ! has a small area, with h(n) very close to a boundary.  Then 
    512 !      ! the coefficients of g(h) are large, and the computed daice and 
    513 !      ! dvice can be in error. If this happens, it is best to transfer 
    514 !      ! either the entire category or nothing at all, depending on which 
    515 !      ! side of the boundary hice(n) lies. 
    516 !      !----------------------------------------------------------------- 
    517 !      DO jl = klbnd, kubnd-1 
    518 ! 
    519 !         zdaice_negative = .false. 
    520 !         zdvice_negative = .false. 
    521 !         zdaice_greater_aicen = .false. 
    522 !         zdvice_greater_vicen = .false. 
    523 ! 
    524 !         DO jj = 1, jpj 
    525 !            DO ji = 1, jpi 
    526 ! 
    527 !               IF (zdonor(ji,jj,jl) > 0) THEN 
    528 !                  jl1 = zdonor(ji,jj,jl) 
    529 ! 
    530 !                  IF (zdaice(ji,jj,jl) < 0.0) THEN 
    531 !                     IF (zdaice(ji,jj,jl) > -epsi10) THEN 
    532 !                        IF ( ( jl1 == jl   .AND. ht_i(ji,jj,jl1) >  hi_max(jl) ) .OR.  & 
    533 !                             ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 
    534 !                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
    535 !                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
    536 !                        ELSE 
    537 !                           zdaice(ji,jj,jl) = 0.0 ! shift no ice 
    538 !                           zdvice(ji,jj,jl) = 0.0 
    539 !                        ENDIF 
    540 !                     ELSE 
    541 !                        zdaice_negative = .true. 
    542 !                     ENDIF 
    543 !                  ENDIF 
    544 ! 
    545 !                  IF (zdvice(ji,jj,jl) < 0.0) THEN 
    546 !                     IF (zdvice(ji,jj,jl) > -epsi10 ) THEN 
    547 !                        IF ( ( jl1 == jl   .AND. ht_i(ji,jj,jl1) >  hi_max(jl) ) .OR.  & 
    548 !                             ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 
    549 !                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
    550 !                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    551 !                        ELSE 
    552 !                           zdaice(ji,jj,jl) = 0.0    ! shift no ice 
    553 !                           zdvice(ji,jj,jl) = 0.0 
    554 !                        ENDIF 
    555 !                    ELSE 
    556 !                       zdvice_negative = .true. 
    557 !                    ENDIF 
    558 !                 ENDIF 
    559 ! 
    560 !                  ! If daice is close to aicen, set daice = aicen. 
    561 !                  IF (zdaice(ji,jj,jl) > a_i(ji,jj,jl1) - epsi10 ) THEN 
    562 !                     IF (zdaice(ji,jj,jl) < a_i(ji,jj,jl1)+epsi10) THEN 
    563 !                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    564 !                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    565 !                    ELSE 
    566 !                       zdaice_greater_aicen = .true. 
    567 !                    ENDIF 
    568 !                  ENDIF 
    569 ! 
    570 !                  IF (zdvice(ji,jj,jl) > v_i(ji,jj,jl1)-epsi10) THEN 
    571 !                     IF (zdvice(ji,jj,jl) < v_i(ji,jj,jl1)+epsi10) THEN 
    572 !                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    573 !                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    574 !                     ELSE 
    575 !                        zdvice_greater_vicen = .true. 
    576 !                     ENDIF 
    577 !                  ENDIF 
    578 ! 
    579 !               ENDIF               ! donor > 0 
    580 !            END DO 
    581 !         END DO 
    582 ! 
    583 !      END DO 
    584 !clem 
    585506      !------------------------------------------------------------------------------- 
    586       ! 3) Transfer volume and energy between categories 
     507      ! 2) Transfer volume and energy between categories 
    587508      !------------------------------------------------------------------------------- 
    588509 
     
    604525 
    605526            jl1 = zdonor(ii,ij,jl) 
    606             rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi20 ) ) 
    607             zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi20 ) * rswitch 
     527            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) ) 
     528            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch 
    608529            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    609530            ELSE                  ;   jl2 = jl  
     
    613534            ! Ice areas 
    614535            !-------------- 
    615  
    616536            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl) 
    617537            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl) 
     
    620540            ! Ice volumes 
    621541            !-------------- 
    622  
    623542            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl)  
    624543            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl) 
     
    627546            ! Snow volumes 
    628547            !-------------- 
    629  
    630548            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    631549            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
     
    635553            ! Snow heat content   
    636554            !-------------------- 
    637  
    638555            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    639556            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
     
    643560            ! Ice age  
    644561            !-------------- 
    645  
    646562            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    647563            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
     
    651567            ! Ice salinity 
    652568            !-------------- 
    653  
    654569            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    655570            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
     
    659574            ! Surface temperature 
    660575            !--------------------- 
    661  
    662576            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    663577            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
     
    710624      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 
    711625      CALL wrk_dealloc( jpi,jpj, zworka ) 
    712       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     626      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    713627      ! 
    714628   END SUBROUTINE lim_itd_shiftice 
     
    859773      ENDIF 
    860774      ! 
    861       CALL wrk_dealloc( jpi,jpj,jpl, zdonor )   ! interger 
     775      CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) 
    862776      CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 
    863777      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5187 r5407  
    3030   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3131   USE sbccpl 
    32    USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     32   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3333   USE albedo           ! albedo parameters 
    3434   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
     
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
     96      !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    101101      !!              The ref should be Rousset et al., 2015 
    102102      !!--------------------------------------------------------------------- 
    103       INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
    104       INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
    105       REAL(wp) ::   zemp                                            ! local scalars 
    106       REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    107       REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     103      INTEGER, INTENT(in) ::   kt                                  ! number of iteration 
     104      INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices 
     105      REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     106      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean 
    108107      ! 
    109108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
     
    111110 
    112111      ! make calls for heat fluxes before it is modified 
    113       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
    114       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
    115       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface 
    116       IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 
    117       IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice 
    118       IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
    119       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 
     112      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
     113      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
     114      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
     115      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
     116      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
     117      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
     118      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
     119         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
     120      IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )   
     121      IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )   
    120122 
    121123      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     
    126128            !      heat flux at the ocean surface      ! 
    127129            !------------------------------------------! 
    128             ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     130            ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    129131            !--------------------------------------------------- 
    130             IF( lk_cpl ) THEN  
    131                !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    132                zfcm1 = qsr_tot(ji,jj) 
    133                DO jl = 1, jpl 
    134                   zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    135                END DO 
    136             ELSE 
    137                !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    138                zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
    139                DO jl = 1, jpl 
    140                   zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
    141                END DO 
    142             ENDIF 
     132            zqsr = qsr_tot(ji,jj) 
     133            DO jl = 1, jpl 
     134               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) )  
     135            END DO 
    143136 
    144137            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
    145138            !--------------------------------------------------- 
    146             zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
    147             hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     139            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     140            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 
    148141 
    149142            ! Add the residual from heat diffusion equation (W.m-2) 
     
    153146            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    154147            !--------------------------------------------------- 
    155             qsr(ji,jj) = zfcm1                                       
    156             qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     148            qsr(ji,jj) = zqsr                                       
     149            qns(ji,jj) = hfx_out(ji,jj) - zqsr               
    157150 
    158151            !------------------------------------------! 
     
    167160            !                     Even if i see Ice melting as a FW and SALT flux 
    168161            !         
    169             !  computing freshwater exchanges at the ice/ocean interface 
    170             IF( lk_cpl ) THEN  
    171                 zemp =   emp_tot(ji,jj)                                    &   ! net mass flux over grid cell 
    172                    &   - emp_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) )         &   ! minus the mass flux intercepted by sea ice 
    173                    &   + sprecip(ji,jj) * ( pfrld(ji,jj) - pfrld(ji,jj)**rn_betas )   ! 
    174             ELSE 
    175                zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
    176                   &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
    177                   &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**rn_betas )       ! except solid precip intercepted by sea-ice 
    178             ENDIF 
    179  
    180162            ! mass flux from ice/ocean 
    181163            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     
    184166            ! mass flux at the ocean/ice interface 
    185167            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model 
    186             emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)             ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     168            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    187169             
    188170         END DO 
     
    213195      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
    214196 
    215       !------------------------------------------------! 
    216       !    Snow/ice albedo (only if sent to coupler)   ! 
    217       !------------------------------------------------! 
    218       IF( lk_cpl ) THEN          ! coupled case 
    219  
    220             CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    221  
    222             CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    223  
    224             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    225  
    226             CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    227  
    228       ENDIF 
     197      !------------------------------------------------------------------------! 
     198      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   ! 
     199      !------------------------------------------------------------------------! 
     200      CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )     
     201      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     202      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     203      CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    229204 
    230205      ! conservation test 
     
    346321            sice_0(:,:) = 2._wp 
    347322         END WHERE 
    348       ENDIF 
    349        
    350       IF( .NOT. ln_rstart ) THEN 
    351          fraqsr_1lev(:,:) = 1._wp 
    352323      ENDIF 
    353324      ! 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5385 r5407  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY : fraqsr_1lev  
    2524   USE ice            ! LIM: sea-ice variables 
    2625   USE sbc_oce        ! Surface boundary condition: ocean fields 
     
    2827   USE thd_ice        ! LIM thermodynamic sea-ice variables 
    2928   USE dom_ice        ! LIM sea-ice domain 
    30    USE domvvl         ! domain: variable volume level 
    3129   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3230   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
     
    5048   PRIVATE 
    5149 
    52    PUBLIC   lim_thd        ! called by limstp module 
    53    PUBLIC   lim_thd_init   ! called by sbc_lim_init 
     50   PUBLIC   lim_thd         ! called by limstp module 
     51   PUBLIC   lim_thd_init    ! called by sbc_lim_init 
    5452 
    5553   !! * Substitutions 
     
    9290      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
    9391      ! 
    94       REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9592      !!------------------------------------------------------------------- 
    96       CALL wrk_alloc( jpi,jpj, zqsr, zqns ) 
    9793 
    9894      IF( nn_timing == 1 )  CALL timing_start('limthd') 
     
    136132      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    137133      !-----------------------------------------------------------------------------! 
    138  
    139       !--- Ocean solar and non solar fluxes to be used in zqld 
    140       IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
    141          ! 
    142          zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
    143          ! 
    144       ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
    145          ! 
    146          zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
    147          ! 
    148          DO jl = 1, jpl 
    149             DO jj = 1, jpj 
    150                DO ji = 1, jpi 
    151                   zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
    152                   zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
    153                END DO 
    154             END DO 
    155          END DO 
    156          ! 
    157       ENDIF 
    158  
    159134      DO jj = 1, jpj 
    160135         DO ji = 1, jpi 
     
    167142            !           !  temperature and turbulent mixing (McPhee, 1992) 
    168143            ! 
    169  
    170144            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
    171             ! REMARK valid at least in forced mode from clem 
    172             ! precip is included in qns but not in qns_ice 
    173             IF ( lk_cpl ) THEN 
    174                zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    175                   &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode 
    176                   &    + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip 
    177                   &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )   & 
    178                   &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 
    179             ELSE 
    180                zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    181                   &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    & 
    182                   &    + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip 
    183                   &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )           & 
    184                   &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 
    185             ENDIF 
     145            zqld =  tmask(ji,jj,1) * rdt_ice *  & 
     146               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    186147 
    187148            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     
    210171            ! Net heat flux on top of ice-ocean [W.m-2] 
    211172            ! ----------------------------------------- 
    212             !     heat flux at the ocean surface + precip 
    213             !   + heat flux at the ice   surface  
    214             hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
    215                ! heat flux above the ocean 
    216                &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
    217                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    218                &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
    219                &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 )          & 
    220                ! heat flux above the ice 
    221                &    +   SUM(    a_i_b(ji,jj,:)   * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 
     173            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    222174 
    223175            ! ----------------------------------------------------------------------------- 
    224             ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     176            ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    225177            ! ----------------------------------------------------------------------------- 
    226178            !     First  step here              :  non solar + precip - qlead - qturb 
    227179            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    228180            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
    229             hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       &  
    230                ! Non solar heat flux received by the ocean 
    231                &    +        pfrld(ji,jj) * zqns(ji,jj)                                                                            & 
    232                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    233                &    +      ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
    234                &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
    235                &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 )       & 
    236                ! heat flux taken from the ocean where there is open water ice formation 
    237                &    -      qlead(ji,jj) * r1_rdtice                                                                               & 
    238                ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
    239                &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             & 
    240                &    -      at_i(ji,jj) *  fhld(ji,jj) 
    241  
     181            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean                
     182               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation 
     183               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence 
     184               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt  
     185                                                                                   !    (fhld should be 0 while bott growth) 
    242186         END DO 
    243187      END DO 
     
    412356      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    413357 
    414       CALL wrk_dealloc( jpi,jpj, zqsr, zqns ) 
    415  
    416358      !------------------------------------------------------------------------------| 
    417359      !  6) Transport of ice between thickness categories.                           | 
     
    472414   END SUBROUTINE lim_thd  
    473415 
     416  
    474417   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    475418      !!----------------------------------------------------------------------- 
     
    570513         END DO 
    571514          
    572          CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)  , jpi, jpj, npb(1:nbpb) ) 
     515         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
    573516         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    574517         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
     
    576519         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    577520         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    578          IF( .NOT. lk_cpl ) THEN 
    579             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    580             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    581          ENDIF 
     521         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    582522         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    583523         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r5202 r5407  
    2929   PRIVATE 
    3030 
    31    PUBLIC   lim_thd_dh   ! called by lim_thd 
     31   PUBLIC   lim_thd_dh      ! called by lim_thd 
     32   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbccpl and here 
     33 
     34   INTERFACE lim_thd_snwblow 
     35      MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d 
     36   END INTERFACE 
    3237 
    3338   !!---------------------------------------------------------------------- 
     
    7176      REAL(wp) ::   zfdum        
    7277      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    73       REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads 
    74       REAL(wp) ::   zs_snic  ! snow-ice salinity 
     78      REAL(wp) ::   zs_snic      ! snow-ice salinity 
    7579      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    7680      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity 
     
    103107      REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2) 
    104108      REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3) 
     109      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing 
    105110 
    106111      REAL(wp) :: zswitch_sal 
     
    118123 
    119124      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
    120       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     125      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s, zsnw ) 
    121126      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 
    122127      CALL wrk_alloc( jpij, nlay_i, icount ) 
     
    219224 
    220225      zdeltah(:,:) = 0._wp 
     226      CALL lim_thd_snwblow( 1. - at_i_1d, zsnw ) ! snow distribution over ice after wind blowing 
    221227      DO ji = kideb, kiut 
    222228         !----------- 
     
    224230         !----------- 
    225231         ! thickness change 
    226          zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**rn_betas ) / at_i_1d(ji)  
    227          zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice * r1_rhosn 
    228          ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 
    229          zqprec   (ji) = rhosn * ( cpic * ( rt0 - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )    
     232         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji) 
     233         ! enthalpy of the precip (>0, J.m-3) 
     234         zqprec   (ji) = - qprec_ice_1d(ji)    
    230235         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 
    231236         ! heat flux from snow precip (>0, W.m-2) 
     
    280285      ! clem comment: ice should also sublimate 
    281286      zdeltah(:,:) = 0._wp 
    282       IF( lk_cpl ) THEN 
    283          ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
    284          zdh_s_sub(:)      =  0._wp  
    285       ELSE 
    286          ! forced  mode: snow thickness change due to sublimation 
    287          DO ji = kideb, kiut 
    288             zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 
    289             ! Heat flux by sublimation [W.m-2], < 0 
    290             !      sublimate first snow that had fallen, then pre-existing snow 
    291             zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
    292             hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  & 
    293                &                              ) * a_i_1d(ji) * r1_rdtice 
    294             ! Mass flux by sublimation 
    295             wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 
    296             ! new snow thickness 
    297             ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
    298             ! update precipitations after sublimation and correct sublimation 
    299             zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
    300             zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 
    301          END DO 
    302       ENDIF 
    303  
     287      ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice 
     288      ! forced  mode: snow thickness change due to sublimation 
     289      DO ji = kideb, kiut 
     290         zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
     291         ! Heat flux by sublimation [W.m-2], < 0 
     292         !      sublimate first snow that had fallen, then pre-existing snow 
     293         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
     294         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  & 
     295            &                              ) * a_i_1d(ji) * r1_rdtice 
     296         ! Mass flux by sublimation 
     297         wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 
     298         ! new snow thickness 
     299         ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
     300         ! update precipitations after sublimation and correct sublimation 
     301         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
     302         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 
     303      END DO 
     304       
    304305      ! --- Update snow diags --- ! 
    305306      DO ji = kideb, kiut 
     
    689690       
    690691      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
    691       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     692      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s, zsnw ) 
    692693      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 
    693694      CALL wrk_dealloc( jpij, nlay_i, icount ) 
     
    695696      ! 
    696697   END SUBROUTINE lim_thd_dh 
     698 
     699 
     700   !!-------------------------------------------------------------------------- 
     701   !! INTERFACE lim_thd_snwblow 
     702   !! ** Purpose :   Compute distribution of precip over the ice 
     703   !!-------------------------------------------------------------------------- 
     704   SUBROUTINE lim_thd_snwblow_2d( pin, pout ) 
     705      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) ) 
     706      REAL(wp), DIMENSION(:,:), INTENT(out) :: pout 
     707      pout = ( 1._wp - ( pin )**rn_betas ) 
     708   END SUBROUTINE lim_thd_snwblow_2d 
     709 
     710   SUBROUTINE lim_thd_snwblow_1d( pin, pout ) 
     711      REAL(wp), DIMENSION(:), INTENT(in)  :: pin 
     712      REAL(wp), DIMENSION(:), INTENT(out) :: pout 
     713      pout = ( 1._wp - ( pin )**rn_betas ) 
     714   END SUBROUTINE lim_thd_snwblow_1d 
     715 
    697716    
    698717#else 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r5385 r5407  
    2424   USE wrk_nemo       ! work arrays 
    2525   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    26    USE sbc_oce, ONLY : lk_cpl 
    2726 
    2827   IMPLICIT NONE 
     
    745744      !-------------------------------------------------------------------------! 
    746745      DO ji = kideb, kiut 
    747          ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)  
    748          IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) ) 
    749746         !                                ! surface ice conduction flux 
    750747         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r5202 r5407  
    176176      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
    177177      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
    178       CALL iom_put( "snowpre"     , sprecip             )        ! snow precipitation  
     178      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation  
    179179      CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
    180180 
     
    232232      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !   
    233233      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !   
    234       CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base  
     234      CALL iom_put ('hfxtur'     , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base  
    235235      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice  
    236236      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip  
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r5167 r5407  
    8989   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    9090   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    91    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice 
    93    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice 
    9493   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    9594   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
     
    153152         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  & 
    154153         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  & 
    155          &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,                     & 
    156          &      tatm_ice_1d(jpij) , i0         (jpij) ,                                         &   
     154         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         & 
     155         &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &   
    157156         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  & 
    158157         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     & 
  • trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r5215 r5407  
    152152      !!---------------------------------------------------------------------- 
    153153      cltxt = '' 
     154      cxios_context = 'nemo' 
    154155      ! 
    155156      !                             ! Open reference namelist and configuration namelist files 
     
    182183#if defined key_iomput 
    183184      CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    184       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
     185      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    185186#else 
    186187      ilocal_comm = 0 
    187       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     188      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    188189#endif 
    189190 
  • trunk/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90

    r5120 r5407  
    133133      ! 
    134134      cltxt = '' 
     135      cxios_context = 'nemo' 
    135136      ! 
    136137      !                             ! Open reference namelist and configuration namelist files 
     
    162163#if defined key_iomput 
    163164      IF( Agrif_Root() ) THEN 
    164          IF( lk_cpl ) THEN 
     165         IF( lk_oasis ) THEN 
    165166            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
    166167            CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
    167168         ELSE 
    168             CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     169            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    169170         ENDIF 
    170171      ENDIF 
    171172      ENDIF 
    172       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
     173      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    173174#else 
    174       IF( lk_cpl ) THEN 
     175      IF( lk_oasis ) THEN 
    175176         IF( Agrif_Root() ) THEN 
    176177            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
    177178         ENDIF 
    178          narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     179         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
    179180      ELSE 
    180181         ilocal_comm = 0 
    181          narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     182         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    182183      ENDIF 
    183184#endif 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5217 r5407  
    593593         ENDIF 
    594594 
    595          IF( .NOT. lk_cpl ) THEN 
     595         IF( .NOT. ln_cpl ) THEN 
    596596            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    597597               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     
    602602         ENDIF 
    603603 
    604          IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     604         IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    605605            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    606606               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     
    625625#endif 
    626626 
    627          IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     627         IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    628628            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    629629               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     
    780780      ENDIF 
    781781 
    782       IF( .NOT. lk_cpl ) THEN 
     782      IF( .NOT. ln_cpl ) THEN 
    783783         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    784784         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     
    786786         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    787787      ENDIF 
    788       IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     788      IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    789789         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    790790         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     
    802802#endif 
    803803 
    804       IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     804      IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    805805         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    806806         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5120 r5407  
    9898      ! 
    9999      CALL wrk_alloc( jpi  , jpj+2, zwu               ) 
    100       CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
     100      CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 ) 
    101101      ! 
    102102      IF( kt == nit000 ) THEN 
  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5363 r5407  
    149149   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
    150150   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
     151   CHARACTER(lc) ::   cxios_context         !: context name used in xios 
    151152 
    152153   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5385 r5407  
    121121      CALL set_scalar 
    122122 
    123       IF( TRIM(cdname) == "nemo" ) THEN   
     123      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    124124         CALL set_grid( "T", glamt, gphit )  
    125125         CALL set_grid( "U", glamu, gphiu ) 
     
    129129      ENDIF 
    130130 
    131       IF( TRIM(cdname) == "nemo_crs" ) THEN   
     131      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
    132132         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    133133         ! 
     
    12121212      CALL iom_swap( cdname )   ! swap to cdname context 
    12131213      CALL xios_update_calendar(kt) 
    1214       IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1214      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    12151215      ! 
    12161216   END SUBROUTINE iom_setkt 
     
    12221222         CALL iom_swap( cdname )   ! swap to cdname context 
    12231223         CALL xios_context_finalize() ! finalize the context 
    1224          IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1224         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    12251225      ENDIF 
    12261226      ! 
     
    12911291         CASE ('T', 'W') 
    12921292            icnr = -1 ; jcnr = -1 
    1293             IF( TRIM(cdname) == "nemo_crs" ) THEN 
     1293            IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 
    12941294               z_cnr(:,:,1) = gphif_crs ; z_cnr(:,:,2) = glamf_crs 
    12951295               z_pnt(:,:,1) = gphit_crs ; z_pnt(:,:,2) = glamt_crs 
     
    13001300         CASE ('U') 
    13011301            icnr =  0 ; jcnr = -1 
    1302             IF( TRIM(cdname) == "nemo_crs" ) THEN 
     1302            IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 
    13031303               z_cnr(:,:,1) = gphiv_crs ; z_cnr(:,:,2) = glamv_crs 
    13041304               z_pnt(:,:,1) = gphiu_crs ; z_pnt(:,:,2) = glamu_crs 
     
    13091309         CASE ('V') 
    13101310            icnr = -1 ; jcnr =  0 
    1311             IF( TRIM(cdname) == "nemo_crs" ) THEN 
     1311            IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 
    13121312               z_cnr(:,:,1) = gphiu_crs ; z_cnr(:,:,2) = glamu_crs 
    13131313               z_pnt(:,:,1) = gphiv_crs ; z_pnt(:,:,2) = glamv_crs 
  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5341 r5407  
    2424   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    26    USE sbc_ice, ONLY : lk_lim3 
    2726 
    2827   IMPLICIT NONE 
     
    135134                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
    136135                     ! 
    137       IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    138                      ! 
    139136                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    140137                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        ) 
     
    148145                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
    149146#endif 
    150                   IF( lk_lim3 ) THEN 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    152                   ENDIF 
    153147      IF( kt == nitrst ) THEN 
    154148         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     
    236230         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    237231         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
    238          IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    239232      ELSE 
    240233         neuler = 0 
     
    279272         ENDIF 
    280273 
    281          IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN 
    282             DO jk = 1, jpk 
    283                fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
    284             END DO 
    285          ENDIF 
    286  
    287       ENDIF 
    288       ! 
    289       IF( lk_lim3 ) THEN 
    290          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    291274      ENDIF 
    292275      ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4990 r5407  
    164164 
    165165 
    166    FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
     166   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
    167167      !!---------------------------------------------------------------------- 
    168168      !!                  ***  routine mynode  *** 
     
    171171      !!---------------------------------------------------------------------- 
    172172      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
     173      CHARACTER(len=*)             , INTENT(in   ) ::   ldname 
    173174      INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist 
    174175      INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist 
     
    297298 
    298299      IF( mynode == 0 ) THEN 
    299         CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    300         WRITE(kumond, nammpp)       
     300         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     301         WRITE(kumond, nammpp)       
    301302      ENDIF 
    302303      ! 
     
    31923193   END FUNCTION lib_mpp_alloc 
    31933194 
    3194    FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value) 
     3195   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value) 
    31953196      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    31963197      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
     3198      CHARACTER(len=*) ::   ldname 
    31973199      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop 
    31983200      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
    31993201      IF( .FALSE. )   ldtxt(:) = 'never done' 
    3200       CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     3202      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    32013203   END FUNCTION mynode 
    32023204 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r4990 r5407  
    1515   !!---------------------------------------------------------------------- 
    1616   !!---------------------------------------------------------------------- 
    17    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
     17   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT 
     18   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3 
    1819   !!---------------------------------------------------------------------- 
    1920   !!   cpl_init     : initialization of coupled mode communication 
     
    6162#endif 
    6263 
    63    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER                    ::   nrcv         ! total number of fields received  
     65   INTEGER                    ::   nsnd         ! total number of fields sent  
     66   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     67   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=50   ! Maximum number of coupling fields 
    6468   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    6569   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
     
    8690CONTAINS 
    8791 
    88    SUBROUTINE cpl_init( kl_comm ) 
     92   SUBROUTINE cpl_init( cd_modname, kl_comm ) 
    8993      !!------------------------------------------------------------------- 
    9094      !!             ***  ROUTINE cpl_init  *** 
     
    9599      !! ** Method  :   OASIS3 MPI communication  
    96100      !!-------------------------------------------------------------------- 
    97       INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model 
     101      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file 
     102      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model 
    98103      !!-------------------------------------------------------------------- 
    99104 
     
    104109      ! 1st Initialize the OASIS system for the application 
    105110      !------------------------------------------------------------------ 
    106       CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     111      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 
    107112      IF ( nerror /= OASIS_Ok ) & 
    108113         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
     
    144149      IF(lwp) WRITE(numout,*) 
    145150 
     151      ncplmodel = kcplmodel 
    146152      IF( kcplmodel > nmaxcpl ) THEN 
    147          CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
     153         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
    148154      ENDIF 
     155 
     156      nrcv = krcv 
     157      IF( nrcv > nmaxfld ) THEN 
     158         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN 
     159      ENDIF 
     160 
     161      nsnd = ksnd 
     162      IF( nsnd > nmaxfld ) THEN 
     163         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN 
     164      ENDIF 
     165 
    149166      ! 
    150167      ! ... Define the shape for the area that excludes the halo 
     
    400417 
    401418 
    402    INTEGER FUNCTION cpl_freq( kid 
     419   INTEGER FUNCTION cpl_freq( cdfieldname 
    403420      !!--------------------------------------------------------------------- 
    404421      !!              ***  ROUTINE cpl_freq  *** 
     
    406423      !! ** Purpose : - send back the coupling frequency for a particular field 
    407424      !!---------------------------------------------------------------------- 
    408       INTEGER,INTENT(in) ::   kid   ! variable index 
    409       !! 
     425      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file 
     426      !! 
     427      INTEGER               :: id 
    410428      INTEGER               :: info 
    411429      INTEGER, DIMENSION(1) :: itmp 
     430      INTEGER               :: ji,jm     ! local loop index 
     431      INTEGER               :: mop 
    412432      !!---------------------------------------------------------------------- 
    413       CALL oasis_get_freqs(kid, 1, itmp, info) 
    414       cpl_freq = itmp(1) 
     433      cpl_freq = 0   ! defaut definition 
     434      id = -1        ! defaut definition 
     435      ! 
     436      DO ji = 1, nsnd 
     437         IF (ssnd(ji)%laction ) THEN 
     438            DO jm = 1, ncplmodel 
     439               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
     440                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 
     441                     id = ssnd(ji)%nid(1,jm) 
     442                     mop = OASIS_Out 
     443                  ENDIF 
     444               ENDIF 
     445            ENDDO 
     446         ENDIF 
     447      ENDDO 
     448      DO ji = 1, nrcv 
     449         IF (srcv(ji)%laction ) THEN 
     450            DO jm = 1, ncplmodel 
     451               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
     452                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 
     453                     id = srcv(ji)%nid(1,jm) 
     454                     mop = OASIS_In 
     455                  ENDIF 
     456               ENDIF 
     457            ENDDO 
     458         ENDIF 
     459      ENDDO 
     460      ! 
     461      IF( id /= -1 ) THEN 
     462#if defined key_oa3mct_v3 
     463         CALL oasis_get_freqs(id, mop, 1, itmp, info) 
     464#else 
     465         CALL oasis_get_freqs(id,      1, itmp, info) 
     466#endif 
     467         cpl_freq = itmp(1) 
     468      ENDIF 
    415469      ! 
    416470   END FUNCTION cpl_freq 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5399 r5407  
    154154      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    155155 
    156       it_offset = 0 
     156      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     157      ELSE                                      ;   it_offset = 0 
     158      ENDIF 
    157159      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    158160 
     
    452454      ENDIF 
    453455      ! 
    454       it_offset = 0 
     456      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     457      ELSE                                      ;   it_offset = 0 
     458      ENDIF 
    455459      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    456460      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r5385 r5407  
    6868   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
    6969   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s] 
    7171 
    7272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    7373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
     74 
     75#if defined  key_lim3 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   evap_ice       !: sublimation                              [kg/m2/s] 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   devap_ice      !: sublimation sensitivity                [kg/m2/s/K] 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qns_oce        !: non solar heat flux over ocean              [W/m2] 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsr_oce        !: non solar heat flux over ocean              [W/m2] 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2] 
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2] 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3] 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
     84#endif 
     85#if defined key_lim3 || defined key_lim2 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
     87#endif 
    7488 
    7589#if defined key_cice 
     
    99113#endif 
    100114 
    101 #if defined key_lim3 || defined key_cice 
    102    ! not used with LIM2 
     115#if defined key_cice 
    103116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    104117#endif 
     
    124137      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    125138         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    126          &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     & 
    127          &      alb_ice (jpi,jpj,jpl) ,                             & 
    128          &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
     139         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   & 
     140         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   & 
    129141         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    130 #if defined key_lim3 
    131          &      tatm_ice(jpi,jpj)     ,                             & 
    132 #endif 
    133142#if defined key_lim2 
    134143         &      a_i(jpi,jpj,jpl)      ,                             & 
     144#endif 
     145#if defined key_lim3 
     146         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  & 
     147         &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       & 
     148         &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  & 
    135149#endif 
    136150         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
     
    144158                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    145159                STAT= ierr(1) ) 
    146       IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     160      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
    147161         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
    148162         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     
    152166         ! 
    153167#if defined key_cice || defined key_lim2 
    154       IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     168      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
    155169#endif 
    156170 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5385 r5407  
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
    3737#if defined key_oasis3 
    38    LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation 
     38   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    3939#else 
    40    LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation 
    41 #endif 
     40   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused 
     41#endif 
     42   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation 
     43   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation 
    4244   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    4345   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
     
    5052   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    5153   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    52    INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation 
     54   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)  
     55   INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation 
    5356   !                                             !: =-1  Use of per-category fluxes 
    5457   !                                             !: = 0  Average per-category fluxes 
     
    6972   !!           switch definition (improve readability) 
    7073   !!---------------------------------------------------------------------- 
    71    INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation 
    72    INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation 
    73    INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation 
    74    INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation 
    75    INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation 
    76    INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation 
    77    INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical               formulation 
     75   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical                    formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk                     formulation 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk                     formulation 
     79   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module 
    7882   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations 
    7983    
     84   !!---------------------------------------------------------------------- 
     85   !!           component definition 
     86   !!---------------------------------------------------------------------- 
     87   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration  
     88                                                         !  (no internal OASIS coupling) 
     89   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component 
     90                                                         !  (internal OASIS coupling) 
     91   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component 
     92                                                         !  (internal OASIS coupling) 
    8093   !!---------------------------------------------------------------------- 
    8194   !!              Ocean Surface Boundary Condition fields 
     
    111124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    112125#endif 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    113127 
    114128   !!---------------------------------------------------------------------- 
     
    122136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
    123137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    124139 
    125140   !! * Substitutions 
     
    155170         &      atm_co2(jpi,jpj) ,                                        & 
    156171#endif 
    157          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       & 
    158          &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) ) 
     172         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
     173         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    159174         ! 
    160175#if defined key_vvl 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5126 r5407  
    3434   USE albedo 
    3535   USE prtctl          ! Print control 
    36 #if defined key_lim3 
     36#if defined key_lim3  
    3737   USE ice 
    3838   USE sbc_ice         ! Surface boundary condition: ice fields 
     39   USE limthd_dh       ! for CALL lim_thd_snwblow 
    3940#elif defined key_lim2 
    4041   USE ice_2 
     42   USE sbc_ice         ! Surface boundary condition: ice fields 
     43   USE par_ice_2       ! Surface boundary condition: ice fields 
    4144#endif 
    4245 
     
    4548 
    4649   PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90  
    47    PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90  
     50#if defined key_lim2 || defined key_lim3 
     51   PUBLIC blk_ice_clio_tau    ! routine called by sbcice_lim.F90  
     52   PUBLIC blk_ice_clio_flx    ! routine called by sbcice_lim.F90  
     53#endif 
    4854 
    4955   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
     
    378384         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
    379385      qns(:,:) = qns(:,:) * tmask(:,:,1) 
     386#if defined key_lim3 
     387      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 
     388      qsr_oce(:,:) = qsr(:,:) 
     389#endif 
    380390      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
    381391 
    382       CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean 
    383       CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean 
    384       CALL iom_put( "qla_oce", - zqla )   ! output downward latent    heat over the ocean 
    385       CALL iom_put( "qns_oce",   qns  )   ! output downward non solar heat over the ocean 
     392      IF ( nn_ice == 0 ) THEN 
     393         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave  heat over the ocean 
     394         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible  heat over the ocean 
     395         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent    heat over the ocean 
     396         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
     397         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     398         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     399         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     400      ENDIF 
    386401 
    387402      IF(ln_ctl) THEN 
     
    399414   END SUBROUTINE blk_oce_clio 
    400415 
    401  
    402    SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  & 
    403       &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    404       &                      p_qla , p_dqns, p_dqla,          & 
    405       &                      p_tpr , p_spr ,                  & 
    406       &                      p_fr1 , p_fr2 , cd_grid, pdim  ) 
     416# if defined key_lim2 || defined key_lim3 
     417   SUBROUTINE blk_ice_clio_tau 
    407418      !!--------------------------------------------------------------------------- 
    408       !!                     ***  ROUTINE blk_ice_clio  *** 
     419      !!                     ***  ROUTINE blk_ice_clio_tau  *** 
     420      !!                  
     421      !!  ** Purpose :   Computation momentum flux at the ice-atm interface   
     422      !!          
     423      !!  ** Method  :   Read utau from a forcing file. Rearrange if C-grid 
     424      !! 
     425      !!---------------------------------------------------------------------- 
     426      REAL(wp) ::   zcoef 
     427      INTEGER  ::   ji, jj   ! dummy loop indices 
     428      !!--------------------------------------------------------------------- 
     429      ! 
     430      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau') 
     431 
     432      SELECT CASE( cp_ice_msh ) 
     433 
     434      CASE( 'C' )                          ! C-grid ice dynamics 
     435 
     436         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress 
     437         utau_ice(:,:) = zcoef * utau(:,:) 
     438         vtau_ice(:,:) = zcoef * vtau(:,:) 
     439 
     440      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
     441 
     442         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress 
     443         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
     444            DO ji = 2, jpi   ! I-grid : no vector opt. 
     445               utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) ) 
     446               vtau_ice(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) ) 
     447            END DO 
     448         END DO 
     449 
     450         CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point 
     451 
     452      END SELECT 
     453 
     454      IF(ln_ctl) THEN 
     455         CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 
     456      ENDIF 
     457 
     458      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau') 
     459 
     460   END SUBROUTINE blk_ice_clio_tau 
     461#endif 
     462 
     463# if defined key_lim2 || defined key_lim3 
     464   SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb ) 
     465      !!--------------------------------------------------------------------------- 
     466      !!                     ***  ROUTINE blk_ice_clio_flx *** 
    409467      !!                  
    410468      !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice 
     
    428486      !!                         to take into account solid precip latent heat flux 
    429487      !!---------------------------------------------------------------------- 
    430       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
     488      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! ice surface temperature                   [Kelvin] 
    431489      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
    432490      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
    433491      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-] 
    434       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    435       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
    436       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2] 
    437       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2] 
    438       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2] 
    439       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2] 
    440       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2] 
    441       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
    442       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
    443       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-] 
    444       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-] 
    445       CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    446       INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories 
    447492      !! 
    448493      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    449       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    450       !! 
    451       REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars 
     494      !! 
     495      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3                    ! temporary scalars 
    452496      REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         - 
    453497      REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         - 
     
    455499      REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         - 
    456500      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
     501      REAL(wp) ::   z1_lsub                                     !    -         - 
    457502      !! 
    458503      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
     
    461506      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    462507      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
     508      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw 
    463509      !!--------------------------------------------------------------------- 
    464510      ! 
    465       IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio') 
     511      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_flx') 
    466512      ! 
    467513      CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    468       CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    469  
    470       ijpl  = pdim                           ! number of ice categories 
     514      CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 
     515 
    471516      zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here) 
    472  
    473 #if defined key_lim3       
    474       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 
    475 #endif 
    476       !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
    477       !------------------------------------! 
    478       !   momentum fluxes  (utau, vtau )   ! 
    479       !------------------------------------! 
    480  
    481       SELECT CASE( cd_grid ) 
    482       CASE( 'C' )                          ! C-grid ice dynamics 
    483          zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress 
    484          p_taui(:,:) = zcoef * utau(:,:) 
    485          p_tauj(:,:) = zcoef * vtau(:,:) 
    486       CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
    487          zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress 
    488          DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
    489             DO ji = 2, jpi   ! I-grid : no vector opt. 
    490                p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) ) 
    491                p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) ) 
    492             END DO 
    493          END DO 
    494          CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point 
    495       END SELECT 
    496  
    497  
     517      !-------------------------------------------------------------------------------- 
    498518      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981). 
    499519      !  and the correction factor for taking into account  the effect of clouds  
    500       !------------------------------------------------------ 
     520      !-------------------------------------------------------------------------------- 
     521 
    501522!CDIR NOVERRCHK 
    502523!CDIR COLLAPSE 
     
    525546            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    526547            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 
    527             p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
     548            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    528549               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    529550               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
     
    535556            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    536557            ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    537             p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
    538             p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
    539          END DO 
    540       END DO 
    541       CALL iom_put( 'snowpre', p_spr )   ! Snow precipitation  
     558            fr1_i0(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
     559            fr2_i0(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
     560         END DO 
     561      END DO 
     562      CALL iom_put( 'snowpre', sprecip )   ! Snow precipitation  
    542563       
    543564      !-----------------------------------------------------------! 
    544565      !  snow/ice Shortwave radiation   (abedo already computed)  ! 
    545566      !-----------------------------------------------------------! 
    546       CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
    547        
    548       DO jl = 1, ijpl 
     567      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 
     568       
     569      DO jl = 1, jpl 
    549570         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   & 
    550571            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 
     
    552573 
    553574      !                                     ! ========================== ! 
    554       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     575      DO jl = 1, jpl                       !  Loop over ice categories  ! 
    555576         !                                  ! ========================== ! 
    556577!CDIR NOVERRCHK 
     
    566587               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    567588               ! 
    568                z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) )  
     589               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) )  
    569590 
    570591               !---------------------------------------- 
     
    573594 
    574595               ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 
    575                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) ) 
     596               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 
    576597               ! humidity close to the ice surface (at saturation) 
    577598               zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 
    578599                
    579600               !  computation of intermediate values 
    580                zticemb  = pst(ji,jj,jl) - 7.66 
     601               zticemb  = ptsu(ji,jj,jl) - 7.66 
    581602               zticemb2 = zticemb * zticemb   
    582                ztice3   = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl) 
     603               ztice3   = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
    583604               zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 ) 
    584605                
     
    593614             
    594615               !  sensible heat flux 
    595                z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) ) 
     616               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 
    596617             
    597618               !  latent heat flux  
    598                p_qla(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  ) 
     619               qla_ice(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  ) 
    599620               
    600621               !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) 
     
    603624               zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
    604625               ! 
    605                p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
    606                p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
     626               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
     627               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
    607628            END DO 
    608629            ! 
     
    616637      ! 
    617638!CDIR COLLAPSE 
    618       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    619 !CDIR COLLAPSE 
    620       p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
     639      qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux 
     640!CDIR COLLAPSE 
     641      tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
    621642      ! 
    622643      ! ----------------------------------------------------------------------------- ! 
     
    625646!CDIR COLLAPSE 
    626647      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with: 
    627          &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip 
    628          &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
    629          &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
    630       ! 
     648         &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip 
     649         &     + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
     650         &     - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
     651 
     652#if defined key_lim3 
     653      ! ----------------------------------------------------------------------------- ! 
     654      !    Distribute evapo, precip & associated heat over ice and ocean 
     655      ! ---------------=====--------------------------------------------------------- ! 
     656      CALL wrk_alloc( jpi,jpj, zevap, zsnw )  
     657 
     658      ! --- evaporation --- ! 
     659      z1_lsub = 1._wp / Lsub 
     660      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
     661      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
     662      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     663 
     664      ! --- evaporation minus precipitation --- ! 
     665      CALL lim_thd_snwblow( pfrld, zsnw )          ! snow redistribution by wind 
     666      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 
     667      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     668      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     669 
     670      ! --- heat flux associated with emp --- ! 
     671      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap 
     672         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip 
     673         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip 
     674         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     675      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     676         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     677 
     678      ! --- total solar and non solar fluxes --- ! 
     679      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     680      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     681 
     682      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     683      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     684 
     685      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
     686#endif 
     687 
    631688!!gm : not necessary as all input data are lbc_lnk... 
    632       CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. ) 
    633       CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. ) 
    634       DO jl = 1, ijpl 
    635          CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. ) 
    636          CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. ) 
    637          CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. ) 
    638          CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. ) 
     689      CALL lbc_lnk( fr1_i0  (:,:) , 'T', 1. ) 
     690      CALL lbc_lnk( fr2_i0  (:,:) , 'T', 1. ) 
     691      DO jl = 1, jpl 
     692         CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 
     693         CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 
     694         CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 
     695         CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 
    639696      END DO 
    640697 
    641698!!gm : mask is not required on forcing 
    642       DO jl = 1, ijpl 
    643          p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 
    644          p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 
    645          p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 
    646          p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 
    647       END DO 
     699      DO jl = 1, jpl 
     700         qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 
     701         qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 
     702         dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 
     703         dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 
     704      END DO 
     705 
     706      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     707      CALL wrk_dealloc( jpi,jpj, jpl  , z_qlw, z_qsb ) 
    648708 
    649709      IF(ln_ctl) THEN 
    650          CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl) 
    651          CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl) 
    652          CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl) 
    653          CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl) 
    654          CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ') 
    655          CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 
     710         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=jpl) 
     711         CALL prt_ctl(tab3d_1=qla_ice  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=qsr_ice  , clinfo2=' qsr_ice  : ', kdim=jpl) 
     712         CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice  , clinfo2=' qns_ice  : ', kdim=jpl) 
     713         CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu    , clinfo2=' ptsu    : ', kdim=jpl) 
     714         CALL prt_ctl(tab2d_1=tprecip  , clinfo1=' blk_ice_clio: tprecip  : ', tab2d_2=sprecip  , clinfo2=' sprecip  : ') 
    656715      ENDIF 
    657716 
    658       CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    659       CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    660       ! 
    661       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio') 
    662       ! 
    663    END SUBROUTINE blk_ice_clio 
    664  
     717      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_flx') 
     718      ! 
     719   END SUBROUTINE blk_ice_clio_flx 
     720 
     721#endif 
    665722 
    666723   SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5385 r5407  
    4444   USE sbc_ice         ! Surface boundary condition: ice fields 
    4545   USE lib_fortran     ! to use key_nosignedzero 
     46#if defined key_lim3 
     47   USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b 
     48   USE limthd_dh       ! for CALL lim_thd_snwblow 
     49#elif defined key_lim2 
     50   USE ice_2, ONLY     : u_ice, v_ice 
     51   USE par_ice_2 
     52#endif 
    4653 
    4754   IMPLICIT NONE 
     
    4956 
    5057   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
    51    PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
     58#if defined key_lim2 || defined key_lim3 
     59   PUBLIC   blk_ice_core_tau     ! routine called in sbc_ice_lim module 
     60   PUBLIC   blk_ice_core_flx     ! routine called in sbc_ice_lim module 
     61#endif 
    5262   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5363 
     
    371381      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    372382         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    373       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux 
     383      ! 
     384      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar  
    374385         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    375386         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
     
    379390         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 
    380391      ! 
    381       CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean 
    382       CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean 
    383       CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean 
    384       CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    385       CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean 
     392#if defined key_lim3 
     393      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3) 
     394      qsr_oce(:,:) = qsr(:,:) 
     395#endif 
     396      ! 
     397      IF ( nn_ice == 0 ) THEN 
     398         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean 
     399         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean 
     400         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean 
     401         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
     402         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     403         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     404         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     405      ENDIF 
    386406      ! 
    387407      IF(ln_ctl) THEN 
     
    401421  
    402422    
    403    SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   & 
    404       &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    405       &                      p_qla , p_dqns, p_dqla,          & 
    406       &                      p_tpr , p_spr ,                  & 
    407       &                      p_fr1 , p_fr2 , cd_grid, pdim  )  
    408       !!--------------------------------------------------------------------- 
    409       !!                     ***  ROUTINE blk_ice_core  *** 
     423#if defined key_lim2 || defined key_lim3 
     424   SUBROUTINE blk_ice_core_tau 
     425      !!--------------------------------------------------------------------- 
     426      !!                     ***  ROUTINE blk_ice_core_tau  *** 
    410427      !! 
    411428      !! ** Purpose :   provide the surface boundary condition over sea-ice 
    412429      !! 
    413       !! ** Method  :   compute momentum, heat and freshwater exchanged 
    414       !!                between atmosphere and sea-ice using CORE bulk 
    415       !!                formulea, ice variables and read atmmospheric fields. 
     430      !! ** Method  :   compute momentum using CORE bulk 
     431      !!                formulea, ice variables and read atmospheric fields. 
    416432      !!                NB: ice drag coefficient is assumed to be a constant 
    417       !!  
    418       !! caution : the net upward water flux has with mm/day unit 
    419       !!--------------------------------------------------------------------- 
    420       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    421       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    422       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    423       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    424       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    425       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    426       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
    427       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
    428       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2] 
    429       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
    430       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
    431       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
    432       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
    433       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
    434       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
    435       CHARACTER(len=1)          , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid) 
    436       INTEGER                   , INTENT(in   ) ::   pdim     ! number of ice categories 
    437       !! 
    438       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    439       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    440       REAL(wp) ::   zst2, zst3 
    441       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    442       REAL(wp) ::   zztmp                                        ! temporary variable 
    443       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    444       REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    445       !! 
    446       REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point 
    447       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
    448       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
    449       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
    450       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    451       !!--------------------------------------------------------------------- 
    452       ! 
    453       IF( nn_timing == 1 )  CALL timing_start('blk_ice_core') 
    454       ! 
    455       CALL wrk_alloc( jpi,jpj, z_wnds_t ) 
    456       CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
    457  
    458       ijpl  = pdim                            ! number of ice categories 
    459  
     433      !!--------------------------------------------------------------------- 
     434      INTEGER  ::   ji, jj    ! dummy loop indices 
     435      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2 
     436      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point 
     437      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point 
     438      !!--------------------------------------------------------------------- 
     439      ! 
     440      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau') 
     441      ! 
    460442      ! local scalars ( place there for vector optimisation purposes) 
    461443      zcoef_wnorm  = rhoa * Cice 
    462444      zcoef_wnorm2 = rhoa * Cice * 0.5 
    463       zcoef_dqlw   = 4.0 * 0.95 * Stef 
    464       zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    465       zcoef_dqsb   = rhoa * cpa * Cice 
    466445 
    467446!!gm brutal.... 
    468       z_wnds_t(:,:) = 0.e0 
    469       p_taui  (:,:) = 0.e0 
    470       p_tauj  (:,:) = 0.e0 
     447      utau_ice  (:,:) = 0._wp 
     448      vtau_ice  (:,:) = 0._wp 
     449      wndm_ice  (:,:) = 0._wp 
    471450!!gm end 
    472451 
    473 #if defined key_lim3 
    474       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 
    475 #endif 
    476452      ! ----------------------------------------------------------------------------- ! 
    477453      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   ! 
    478454      ! ----------------------------------------------------------------------------- ! 
    479       SELECT CASE( cd_grid ) 
     455      SELECT CASE( cp_ice_msh ) 
    480456      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    481457         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
     
    484460               ! ... scalar wind at I-point (fld being at T-point) 
    485461               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    486                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj) 
     462                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj) 
    487463               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    488                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj) 
     464                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
    489465               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    490466               ! ... ice stress at I-point 
    491                p_taui(ji,jj) = zwnorm_f * zwndi_f 
    492                p_tauj(ji,jj) = zwnorm_f * zwndj_f 
     467               utau_ice(ji,jj) = zwnorm_f * zwndi_f 
     468               vtau_ice(ji,jj) = zwnorm_f * zwndj_f 
    493469               ! ... scalar wind at T-point (fld being at T-point) 
    494                zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    495                   &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    496                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    497                   &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    498                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     470               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   & 
     471                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  ) 
     472               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   & 
     473                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  ) 
     474               wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    499475            END DO 
    500476         END DO 
    501          CALL lbc_lnk( p_taui  , 'I', -1. ) 
    502          CALL lbc_lnk( p_tauj  , 'I', -1. ) 
    503          CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     477         CALL lbc_lnk( utau_ice, 'I', -1. ) 
     478         CALL lbc_lnk( vtau_ice, 'I', -1. ) 
     479         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    504480         ! 
    505481      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    506482         DO jj = 2, jpj 
    507483            DO ji = fs_2, jpi   ! vect. opt. 
    508                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
    509                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
    510                z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     484               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
     485               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     486               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    511487            END DO 
    512488         END DO 
    513489         DO jj = 2, jpjm1 
    514490            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    515                p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          & 
    516                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) ) 
    517                p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          & 
    518                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) ) 
     491               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
     492                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
     493               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
     494                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
    519495            END DO 
    520496         END DO 
    521          CALL lbc_lnk( p_taui  , 'U', -1. ) 
    522          CALL lbc_lnk( p_tauj  , 'V', -1. ) 
    523          CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     497         CALL lbc_lnk( utau_ice, 'U', -1. ) 
     498         CALL lbc_lnk( vtau_ice, 'V', -1. ) 
     499         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    524500         ! 
    525501      END SELECT 
     502 
     503      IF(ln_ctl) THEN 
     504         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ') 
     505         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice_core: wndm_ice : ') 
     506      ENDIF 
     507 
     508      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau') 
     509       
     510   END SUBROUTINE blk_ice_core_tau 
     511 
     512 
     513   SUBROUTINE blk_ice_core_flx( ptsu, palb ) 
     514      !!--------------------------------------------------------------------- 
     515      !!                     ***  ROUTINE blk_ice_core_flx  *** 
     516      !! 
     517      !! ** Purpose :   provide the surface boundary condition over sea-ice 
     518      !! 
     519      !! ** Method  :   compute heat and freshwater exchanged 
     520      !!                between atmosphere and sea-ice using CORE bulk 
     521      !!                formulea, ice variables and read atmmospheric fields. 
     522      !!  
     523      !! caution : the net upward water flux has with mm/day unit 
     524      !!--------------------------------------------------------------------- 
     525      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu          ! sea ice surface temperature 
     526      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb          ! ice albedo (all skies) 
     527      !! 
     528      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     529      REAL(wp) ::   zst2, zst3 
     530      REAL(wp) ::   zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
     531      REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable 
     532      !! 
     533      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
     534      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
     535      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
     536      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
     537      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3) 
     538      !!--------------------------------------------------------------------- 
     539      ! 
     540      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_flx') 
     541      ! 
     542      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     543 
     544      ! local scalars ( place there for vector optimisation purposes) 
     545      zcoef_dqlw   = 4.0 * 0.95 * Stef 
     546      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
     547      zcoef_dqsb   = rhoa * cpa * Cice 
    526548 
    527549      zztmp = 1. / ( 1. - albo ) 
    528550      !                                     ! ========================== ! 
    529       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     551      DO jl = 1, jpl                        !  Loop over ice categories  ! 
    530552         !                                  ! ========================== ! 
    531553         DO jj = 1 , jpj 
     
    534556               !      I   Radiative FLUXES   ! 
    535557               ! ----------------------------! 
    536                zst2 = pst(ji,jj,jl) * pst(ji,jj,jl) 
    537                zst3 = pst(ji,jj,jl) * zst2 
     558               zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
     559               zst3 = ptsu(ji,jj,jl) * zst2 
    538560               ! Short Wave (sw) 
    539                p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
     561               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    540562               ! Long  Wave (lw) 
    541                z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     563               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    542564               ! lw sensitivity 
    543565               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
     
    549571               ! ... turbulent heat fluxes 
    550572               ! Sensible Heat 
    551                z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
     573               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    552574               ! Latent Heat 
    553                p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
    554                   &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    555                ! Latent heat sensitivity for ice (Dqla/Dt) 
    556                IF( p_qla(ji,jj,jl) > 0._wp ) THEN 
    557                   p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     575               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                            
     576                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
     577              ! Latent heat sensitivity for ice (Dqla/Dt) 
     578               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
     579                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 
    558580               ELSE 
    559                   p_dqla(ji,jj,jl) = 0._wp 
     581                  dqla_ice(ji,jj,jl) = 0._wp 
    560582               ENDIF 
    561583 
    562584               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    563                z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
     585               z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj) 
    564586 
    565587               ! ----------------------------! 
     
    567589               ! ----------------------------! 
    568590               ! Downward Non Solar flux 
    569                p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl) 
     591               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 
    570592               ! Total non solar heat flux sensitivity for ice 
    571                p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) ) 
     593               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 
    572594            END DO 
    573595            ! 
     
    576598      END DO 
    577599      ! 
     600      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     601      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
     602      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation 
     603      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
     604 
     605#if defined  key_lim3 
     606      CALL wrk_alloc( jpi,jpj, zevap, zsnw )  
     607 
     608      ! --- evaporation --- ! 
     609      z1_lsub = 1._wp / Lsub 
     610      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
     611      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
     612      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     613 
     614      ! --- evaporation minus precipitation --- ! 
     615      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing  
     616      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
     617      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     618      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     619 
     620      ! --- heat flux associated with emp --- ! 
     621      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst 
     622         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
     623         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
     624         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     625      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     626         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     627 
     628      ! --- total solar and non solar fluxes --- ! 
     629      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     630      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     631 
     632      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     633      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     634 
     635      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
     636#endif 
     637 
    578638      !-------------------------------------------------------------------- 
    579639      ! FRACTIONs of net shortwave radiation which is not absorbed in the 
     
    581641      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    582642      ! 
    583       p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
    584       p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    585       ! 
    586       p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    587       p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    588       CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
    589       CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation 
     643      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     644      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     645      ! 
    590646      ! 
    591647      IF(ln_ctl) THEN 
    592          CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl) 
    593          CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl) 
    594          CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl) 
    595          CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl) 
    596          CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl) 
    597          CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ') 
    598          CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ') 
    599          CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 
    600       ENDIF 
    601  
    602       CALL wrk_dealloc( jpi,jpj,   z_wnds_t ) 
    603       CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    604       ! 
    605       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core') 
    606       ! 
    607    END SUBROUTINE blk_ice_core 
     648         CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl) 
     649         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl) 
     650         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb   : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw   : ', kdim=jpl) 
     651         CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice  : ', kdim=jpl) 
     652         CALL prt_ctl(tab3d_1=ptsu    , clinfo1=' blk_ice_core: ptsu     : ', tab3d_2=qns_ice , clinfo2=' qns_ice  : ', kdim=jpl) 
     653         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ') 
     654      ENDIF 
     655 
     656      CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
     657      ! 
     658      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx') 
     659       
     660   END SUBROUTINE blk_ice_core_flx 
     661#endif 
    608662 
    609663   SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    & 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5363 r5407  
    2121   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2222   USE sbc_ice         ! Surface boundary condition: ice fields 
     23   USE sbcapr 
    2324   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2425   USE phycst          ! physical constants 
     
    3233   USE cpl_oasis3      ! OASIS3 coupling 
    3334   USE geo2ocean       !  
    34    USE oce   , ONLY : tsn, un, vn 
     35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    3536   USE albedo          ! 
    3637   USE in_out_manager  ! I/O manager 
     
    4041   USE timing          ! Timing 
    4142   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE eosbn2 
     44   USE sbcrnf   , ONLY : l_rnfcpl 
    4245#if defined key_cpl_carbon_cycle 
    4346   USE p4zflx, ONLY : oce_co2 
     
    4649   USE ice_domain_size, only: ncat 
    4750#endif 
     51#if defined key_lim3 
     52   USE limthd_dh       ! for CALL lim_thd_snwblow 
     53#endif 
     54 
    4855   IMPLICIT NONE 
    4956   PRIVATE 
    50 !EM XIOS-OASIS-MCT compliance 
     57 
    5158   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    5259   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
     
    8996   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    9097   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    91    INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    92  
    93    INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     98   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux 
     99   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature 
     100   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity 
     101   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1 
     102   INTEGER, PARAMETER ::   jpr_ocy1   = 38            ! 
     103   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height 
     104   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction           
     105   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
     106   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
     107   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108 
     109   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    94110   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    95111   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
     
    106122   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    107123   INTEGER, PARAMETER ::   jps_co2    = 15 
    108    INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended 
     124   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity 
     125   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height 
     126   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean 
     127   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean 
     128   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip) 
     129   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux 
     130   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1 
     131   INTEGER, PARAMETER ::   jps_oty1   = 23            !  
     132   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs 
     133   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module 
     134   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
     135   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
     136   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
     137   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
    109138 
    110139   !                                                         !!** namelist namsbc_cpl ** 
     
    125154   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    126155                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    127  
    128    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    129  
    130156   TYPE ::   DYNARR      
    131157      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     
    139165 
    140166   !! Substitution 
     167#  include "domzgr_substitute.h90" 
    141168#  include "vectopt_loop_substitute.h90" 
    142169   !!---------------------------------------------------------------------- 
     
    161188      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    162189#endif 
    163       ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     190      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
    164191      ! 
    165192      sbc_cpl_alloc = MAXVAL( ierr ) 
     
    182209      !!              * initialise the OASIS coupler 
    183210      !!---------------------------------------------------------------------- 
    184       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
     211      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    185212      !! 
    186213      INTEGER ::   jn   ! dummy loop index 
     
    216243         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    217244         WRITE(numout,*)'~~~~~~~~~~~~' 
     245      ENDIF 
     246      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    218247         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    219248         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     
    359388      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    360389      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
     390      CASE( 'none'          )       ! nothing to do 
    361391      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    362392      CASE( 'conservative'  ) 
     
    370400      !                                                      !     Runoffs & Calving     !    
    371401      !                                                      ! ------------------------- ! 
    372       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    373 ! This isn't right - really just want ln_rnf_emp changed 
    374 !                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    375 !                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
    376 !                                                 ENDIF 
     402      srcv(jpr_rnf   )%clname = 'O_Runoff' 
     403      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
     404         srcv(jpr_rnf)%laction = .TRUE. 
     405         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
     406         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     407         IF(lwp) WRITE(numout,*) 
     408         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf 
     409      ENDIF 
     410      ! 
    377411      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    378412 
     
    384418      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    385419      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
     420      CASE( 'none'          )       ! nothing to do 
    386421      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    387422      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
     
    399434      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    400435      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
     436      CASE( 'none'          )       ! nothing to do 
    401437      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    402438      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
     
    414450      ! 
    415451      ! non solar sensitivity mandatory for LIM ice model 
    416       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     452      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 
    417453         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    418454      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
     
    447483         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    448484      ENDIF 
    449  
    450       ! Allocate all parts of frcv used for received fields 
     485      !                                                      ! ------------------------------- ! 
     486      !                                                      !   OPA-SAS coupling - rcv by opa !    
     487      !                                                      ! ------------------------------- ! 
     488      srcv(jpr_sflx)%clname = 'O_SFLX' 
     489      srcv(jpr_fice)%clname = 'RIceFrc' 
     490      ! 
     491      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 
     492         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     493         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     494         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     495         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 
     496         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point 
     497         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point 
     498         ! Vectors: change of sign at north fold ONLY if on the local grid 
     499         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 
     500         sn_rcv_tau%clvgrd = 'U,V' 
     501         sn_rcv_tau%clvor = 'local grid' 
     502         sn_rcv_tau%clvref = 'spherical' 
     503         sn_rcv_emp%cldes = 'oce only' 
     504         ! 
     505         IF(lwp) THEN                        ! control print 
     506            WRITE(numout,*) 
     507            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     508            WRITE(numout,*)'               OPA component  ' 
     509            WRITE(numout,*) 
     510            WRITE(numout,*)'  received fields from SAS component ' 
     511            WRITE(numout,*)'                  ice cover ' 
     512            WRITE(numout,*)'                  oce only EMP  ' 
     513            WRITE(numout,*)'                  salt flux  ' 
     514            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     515            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     516            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates ' 
     517            WRITE(numout,*)'                  wind stress module' 
     518            WRITE(numout,*) 
     519         ENDIF 
     520      ENDIF 
     521      !                                                      ! -------------------------------- ! 
     522      !                                                      !   OPA-SAS coupling - rcv by sas  !    
     523      !                                                      ! -------------------------------- ! 
     524      srcv(jpr_toce  )%clname = 'I_SSTSST' 
     525      srcv(jpr_soce  )%clname = 'I_SSSal' 
     526      srcv(jpr_ocx1  )%clname = 'I_OCurx1' 
     527      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
     528      srcv(jpr_ssh   )%clname = 'I_SSHght' 
     529      srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
     530      srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     531      ! 
     532      IF( nn_components == jp_iam_sas ) THEN 
     533         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     534         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     535         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     536         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 
     537         srcv( jpr_e3t1st )%laction = lk_vvl 
     538         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point 
     539         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point 
     540         ! Vectors: change of sign at north fold ONLY if on the local grid 
     541         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 
     542         ! Change first letter to couple with atmosphere if already coupled OPA 
     543         ! this is nedeed as each variable name used in the namcouple must be unique: 
     544         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
     545         DO jn = 1, jprcv 
     546            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     547         END DO 
     548         ! 
     549         IF(lwp) THEN                        ! control print 
     550            WRITE(numout,*) 
     551            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     552            WRITE(numout,*)'               SAS component  ' 
     553            WRITE(numout,*) 
     554            IF( .NOT. ln_cpl ) THEN 
     555               WRITE(numout,*)'  received fields from OPA component ' 
     556            ELSE 
     557               WRITE(numout,*)'  Additional received fields from OPA component : ' 
     558            ENDIF 
     559            WRITE(numout,*)'               sea surface temperature (Celcius) ' 
     560            WRITE(numout,*)'               sea surface salinity '  
     561            WRITE(numout,*)'               surface currents '  
     562            WRITE(numout,*)'               sea surface height '  
     563            WRITE(numout,*)'               thickness of first ocean T level '         
     564            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     565            WRITE(numout,*) 
     566         ENDIF 
     567      ENDIF 
     568       
     569      ! =================================================== ! 
     570      ! Allocate all parts of frcv used for received fields ! 
     571      ! =================================================== ! 
    451572      DO jn = 1, jprcv 
    452573         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     
    454575      ! Allocate taum part of frcv which is used even when not received as coupling field 
    455576      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     577      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     578      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     579      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     580      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     581      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    456582      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    457583      IF( k_ice /= 0 ) THEN 
     
    485611      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    486612      END SELECT 
    487       
     613            
    488614      !                                                      ! ------------------------- ! 
    489615      !                                                      !          Albedo           ! 
     
    518644         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
    519645      ENDIF 
    520  
     646       
    521647      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    522648      CASE( 'none'         )       ! nothing to do 
     
    567693      !                                                      ! ------------------------- ! 
    568694      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
     695 
     696      !                                                      ! ------------------------------- ! 
     697      !                                                      !   OPA-SAS coupling - snd by opa !    
     698      !                                                      ! ------------------------------- ! 
     699      ssnd(jps_ssh   )%clname = 'O_SSHght'  
     700      ssnd(jps_soce  )%clname = 'O_SSSal'  
     701      ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     702      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
     703      ! 
     704      IF( nn_components == jp_iam_opa ) THEN 
     705         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     706         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 
     707         ssnd( jps_e3t1st )%laction = lk_vvl 
     708         ! vector definition: not used but cleaner... 
     709         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
     710         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
     711         sn_snd_crt%clvgrd = 'U,V' 
     712         sn_snd_crt%clvor = 'local grid' 
     713         sn_snd_crt%clvref = 'spherical' 
     714         ! 
     715         IF(lwp) THEN                        ! control print 
     716            WRITE(numout,*) 
     717            WRITE(numout,*)'  sent fields to SAS component ' 
     718            WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     719            WRITE(numout,*)'               sea surface salinity '  
     720            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
     721            WRITE(numout,*)'               sea surface height '  
     722            WRITE(numout,*)'               thickness of first ocean T level '         
     723            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     724            WRITE(numout,*) 
     725         ENDIF 
     726      ENDIF 
     727      !                                                      ! ------------------------------- ! 
     728      !                                                      !   OPA-SAS coupling - snd by sas !    
     729      !                                                      ! ------------------------------- ! 
     730      ssnd(jps_sflx  )%clname = 'I_SFLX'      
     731      ssnd(jps_fice2 )%clname = 'IIceFrc' 
     732      ssnd(jps_qsroce)%clname = 'I_QsrOce'    
     733      ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
     734      ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
     735      ssnd(jps_otx1  )%clname = 'I_OTaux1'    
     736      ssnd(jps_oty1  )%clname = 'I_OTauy1'    
     737      ssnd(jps_rnf   )%clname = 'I_Runoff'    
     738      ssnd(jps_taum  )%clname = 'I_TauMod'    
     739      ! 
     740      IF( nn_components == jp_iam_sas ) THEN 
     741         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     742         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 
     743         ! 
     744         ! Change first letter to couple with atmosphere if already coupled with sea_ice 
     745         ! this is nedeed as each variable name used in the namcouple must be unique: 
     746         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
     747         DO jn = 1, jpsnd 
     748            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     749         END DO 
     750         ! 
     751         IF(lwp) THEN                        ! control print 
     752            WRITE(numout,*) 
     753            IF( .NOT. ln_cpl ) THEN 
     754               WRITE(numout,*)'  sent fields to OPA component ' 
     755            ELSE 
     756               WRITE(numout,*)'  Additional sent fields to OPA component : ' 
     757            ENDIF 
     758            WRITE(numout,*)'                  ice cover ' 
     759            WRITE(numout,*)'                  oce only EMP  ' 
     760            WRITE(numout,*)'                  salt flux  ' 
     761            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     762            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     763            WRITE(numout,*)'                  wind stress U,V components' 
     764            WRITE(numout,*)'                  wind stress module' 
     765         ENDIF 
     766      ENDIF 
     767 
    569768      ! 
    570769      ! ================================ ! 
     
    572771      ! ================================ ! 
    573772 
    574       CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     773      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
     774       
    575775      IF (ln_usecplmask) THEN  
    576776         xcplmask(:,:,:) = 0. 
     
    582782         xcplmask(:,:,:) = 1. 
    583783      ENDIF 
    584       ! 
    585       IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
     784      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     785      ! 
     786      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) 
     787      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   & 
    586788         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
     789      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    587790 
    588791      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
     
    638841      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    639842      !!---------------------------------------------------------------------- 
    640       INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    641       INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    642       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    643       !! 
    644       LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module?? 
     843      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
     844      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     845      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     846 
     847      !! 
     848      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    645849      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    646850      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     
    650854      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    651855      REAL(wp) ::   zzx, zzy               ! temporary variables 
    652       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     856      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    653857      !!---------------------------------------------------------------------- 
    654858      ! 
    655859      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    656860      ! 
    657       CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    658       !                                                 ! Receive all the atmos. fields (including ice information) 
    659       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    660       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    661          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
     861      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     862      ! 
     863      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     864      ! 
     865      !                                                      ! ======================================================= ! 
     866      !                                                      ! Receive all the atmos. fields (including ice information) 
     867      !                                                      ! ======================================================= ! 
     868      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
     869      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
     870         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
    662871      END DO 
    663872 
     
    719928         ! 
    720929      ENDIF 
    721        
    722930      !                                                      ! ========================= ! 
    723931      !                                                      !    wind stress module     !   (taum) 
     
    748956         ENDIF 
    749957      ENDIF 
    750        
     958      ! 
    751959      !                                                      ! ========================= ! 
    752960      !                                                      !      10 m wind speed      !   (wndm) 
     
    761969!CDIR NOVERRCHK 
    762970               DO ji = 1, jpi  
    763                   wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     971                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    764972               END DO 
    765973            END DO 
    766974         ENDIF 
    767       ELSE 
    768          IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
    769975      ENDIF 
    770976 
     
    773979      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    774980         ! 
    775          utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    776          vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    777          taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     981         IF( ln_mixcpl ) THEN 
     982            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
     983            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
     984            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
     985            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
     986         ELSE 
     987            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     988            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     989            taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     990            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     991         ENDIF 
    778992         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    779993         !   
     
    781995 
    782996#if defined key_cpl_carbon_cycle 
    783       !                                                              ! atmosph. CO2 (ppm) 
     997      !                                                      ! ================== ! 
     998      !                                                      ! atmosph. CO2 (ppm) ! 
     999      !                                                      ! ================== ! 
    7841000      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    7851001#endif 
    7861002 
     1003      !  Fields received by SAS when OASIS coupling 
     1004      !  (arrays no more filled at sbcssm stage) 
     1005      !                                                      ! ================== ! 
     1006      !                                                      !        SSS         ! 
     1007      !                                                      ! ================== ! 
     1008      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1009         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 
     1010         CALL iom_put( 'sss_m', sss_m ) 
     1011      ENDIF 
     1012      !                                                
     1013      !                                                      ! ================== ! 
     1014      !                                                      !        SST         ! 
     1015      !                                                      ! ================== ! 
     1016      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1017         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 
     1018         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature 
     1019            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 
     1020         ENDIF 
     1021      ENDIF 
     1022      !                                                      ! ================== ! 
     1023      !                                                      !        SSH         ! 
     1024      !                                                      ! ================== ! 
     1025      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1026         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
     1027         CALL iom_put( 'ssh_m', ssh_m ) 
     1028      ENDIF 
     1029      !                                                      ! ================== ! 
     1030      !                                                      !  surface currents  ! 
     1031      !                                                      ! ================== ! 
     1032      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1033         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
     1034         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1035         CALL iom_put( 'ssu_m', ssu_m ) 
     1036      ENDIF 
     1037      IF( srcv(jpr_ocy1)%laction ) THEN 
     1038         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
     1039         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1040         CALL iom_put( 'ssv_m', ssv_m ) 
     1041      ENDIF 
     1042      !                                                      ! ======================== ! 
     1043      !                                                      !  first T level thickness ! 
     1044      !                                                      ! ======================== ! 
     1045      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling 
     1046         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 
     1047         CALL iom_put( 'e3t_m', e3t_m(:,:) ) 
     1048      ENDIF 
     1049      !                                                      ! ================================ ! 
     1050      !                                                      !  fraction of solar net radiation ! 
     1051      !                                                      ! ================================ ! 
     1052      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling 
     1053         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 
     1054         CALL iom_put( 'frq_m', frq_m ) 
     1055      ENDIF 
     1056       
    7871057      !                                                      ! ========================= ! 
    788       IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
     1058      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    7891059         !                                                   ! ========================= ! 
    7901060         ! 
    7911061         !                                                       ! total freshwater fluxes over the ocean (emp) 
    792          SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    793          CASE( 'conservative' ) 
    794             emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    795          CASE( 'oce only', 'oce and ice' ) 
    796             emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    797          CASE default 
    798             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    799          END SELECT 
     1062         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 
     1063            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
     1064            CASE( 'conservative' ) 
     1065               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
     1066            CASE( 'oce only', 'oce and ice' ) 
     1067               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
     1068            CASE default 
     1069               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
     1070            END SELECT 
     1071         ELSE 
     1072            zemp(:,:) = 0._wp 
     1073         ENDIF 
    8001074         ! 
    8011075         !                                                        ! runoffs and calving (added in emp) 
    802          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    803          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    804          ! 
    805 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    806 !!gm                                       at least should be optional... 
    807 !!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    808 !!            ! remove negative runoff 
    809 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    810 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    811 !!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    812 !!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    813 !!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    814 !!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    815 !!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    816 !!            ENDIF      
    817 !!            ! add runoff to e-p  
    818 !!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    819 !!         ENDIF 
    820 !!gm  end of internal cooking 
     1076         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1077         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1078          
     1079         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     1080         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
     1081         ENDIF 
    8211082         ! 
    8221083         !                                                       ! non solar heat flux over the ocean (qns) 
    823          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    824          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1084         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1085         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1086         ELSE                                       ;   zqns(:,:) = 0._wp 
     1087         END IF 
    8251088         ! update qns over the free ocean with: 
    826          qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
    827          IF( srcv(jpr_snow  )%laction )   THEN 
    828               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1089         IF( nn_components /= jp_iam_opa ) THEN 
     1090            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST) 
     1091            IF( srcv(jpr_snow  )%laction ) THEN 
     1092               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1093            ENDIF 
     1094         ENDIF 
     1095         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
     1096         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    8291097         ENDIF 
    8301098 
    8311099         !                                                       ! solar flux over the ocean          (qsr) 
    832          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    833          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    834          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     1100         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     1101         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1102         ELSE                                       ;   zqsr(:,:) = 0._wp 
     1103         ENDIF 
     1104         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle 
     1105         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
     1106         ELSE                   ;   qsr(:,:) =                              zqsr(:,:) 
     1107         ENDIF 
    8351108         ! 
    836    
    837       ENDIF 
    838       ! 
    839       CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     1109         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 
     1110         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1) 
     1111         ! Ice cover  (received by opa in case of opa <-> sas coupling) 
     1112         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
     1113         ! 
     1114 
     1115      ENDIF 
     1116      ! 
     1117      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
    8401118      ! 
    8411119      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    9341212            ! 
    9351213         ENDIF 
    936  
    9371214         !                                                      ! ======================= ! 
    9381215         !                                                      !     put on ice grid     ! 
     
    10561333    
    10571334 
    1058    SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
     1335   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 
    10591336      !!---------------------------------------------------------------------- 
    10601337      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
     
    10981375      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    10991376      ! optional arguments, used only in 'mixed oce-ice' case 
    1100       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
    1101       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    1102       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1103       ! 
    1104       INTEGER ::   jl   ! dummy loop index 
    1105       REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
     1377      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1378      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
     1379      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
     1380      ! 
     1381      INTEGER ::   jl         ! dummy loop index 
     1382      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
     1383      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
     1384      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
     1385      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ! for LIM3 
    11061386      !!---------------------------------------------------------------------- 
    11071387      ! 
    11081388      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    11091389      ! 
    1110       CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    1111  
     1390      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1391      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1392 
     1393      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    11121394      zicefr(:,:) = 1.- p_frld(:,:) 
    11131395      zcptn(:,:) = rcp * sst_m(:,:) 
     
    11171399      !                                                      ! ========================= ! 
    11181400      ! 
    1119       !                                                           ! total Precipitations - total Evaporation (emp_tot) 
    1120       !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    1121       !                                                           ! solid Precipitation                      (sprecip) 
     1401      !                                                           ! total Precipitation - total Evaporation (emp_tot) 
     1402      !                                                           ! solid precipitation - sublimation       (emp_ice) 
     1403      !                                                           ! solid Precipitation                     (sprecip) 
     1404      !                                                           ! liquid + solid Precipitation            (tprecip) 
    11221405      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11231406      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1124          sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
    1125          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
    1126          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    1127          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1407         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here 
     1408         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 
     1409         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
     1410         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    11281411            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    11291412         IF( iom_use('hflx_rain_cea') )   & 
     
    11361419            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
    11371420      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1138          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1139          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    1140          sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
     1421         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1422         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1423         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
     1424         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    11411425      END SELECT 
     1426 
     1427      IF( iom_use('subl_ai_cea') )   & 
     1428         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     1429      !    
     1430      !                                                           ! runoffs and calving (put in emp_tot) 
     1431      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1432      IF( srcv(jpr_cal)%laction ) THEN  
     1433         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1434         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1435      ENDIF 
     1436 
     1437      IF( ln_mixcpl ) THEN 
     1438         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1439         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1440         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1441         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1442      ELSE 
     1443         emp_tot(:,:) =                                  zemp_tot(:,:) 
     1444         emp_ice(:,:) =                                  zemp_ice(:,:) 
     1445         sprecip(:,:) =                                  zsprecip(:,:) 
     1446         tprecip(:,:) =                                  ztprecip(:,:) 
     1447      ENDIF 
    11421448 
    11431449         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     
    11461452      IF( iom_use('snow_ai_cea') )   & 
    11471453         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
    1148       IF( iom_use('subl_ai_cea') )   & 
    1149          CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1150       !    
    1151       !                                                           ! runoffs and calving (put in emp_tot) 
    1152       IF( srcv(jpr_rnf)%laction ) THEN  
    1153          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1154             CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1155          IF( iom_use('hflx_rnf_cea') )   & 
    1156             CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    1157       ENDIF 
    1158       IF( srcv(jpr_cal)%laction ) THEN  
    1159          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1160          CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    1161       ENDIF 
    1162       ! 
    1163 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    1164 !!gm                                       at least should be optional... 
    1165 !!       ! remove negative runoff                            ! sum over the global domain 
    1166 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1167 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    1168 !!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    1169 !!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    1170 !!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    1171 !!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1172 !!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    1173 !!       ENDIF      
    1174 !!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    1175 !! 
    1176 !!gm  end of internal cooking 
    11771454 
    11781455      !                                                      ! ========================= ! 
     
    11801457      !                                                      ! ========================= ! 
    11811458      CASE( 'oce only' )                                     ! the required field is directly provided 
    1182          qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1459         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    11831460      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1184          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1461         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    11851462         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1186             qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1463            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    11871464         ELSE 
    11881465            ! Set all category values equal for the moment 
    11891466            DO jl=1,jpl 
    1190                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1467               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    11911468            ENDDO 
    11921469         ENDIF 
    11931470      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1194          qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1471         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    11951472         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    11961473            DO jl=1,jpl 
    1197                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    1198                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1474               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1475               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    11991476            ENDDO 
    12001477         ELSE 
    12011478            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12021479            DO jl=1,jpl 
    1203                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1480               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1481               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12041482            ENDDO 
    12051483         ENDIF 
    12061484      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    12071485! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    1208          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1209          qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1486         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1487         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    12101488            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    12111489            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12121490      END SELECT 
    1213       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
    1214       qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
    1215          &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
    1216          &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
    1217          &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    1218       IF( iom_use('hflx_snow_cea') )   & 
    1219          CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12201491!!gm 
    1221 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     1492!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in  
    12221493!!    the flux that enter the ocean.... 
    12231494!!    moreover 1 - it is not diagnose anywhere....  
     
    12281499      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    12291500         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1230          qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
     1501         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 
    12311502         IF( iom_use('hflx_cal_cea') )   & 
    12321503            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12331504      ENDIF 
     1505 
     1506      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 
     1507      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1508 
     1509#if defined key_lim3 
     1510      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1511 
     1512      ! --- evaporation --- ! 
     1513      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 
     1514      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 
     1515      !                 but it is incoherent WITH the ice model   
     1516      DO jl=1,jpl 
     1517         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1) 
     1518      ENDDO 
     1519      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
     1520 
     1521      ! --- evaporation minus precipitation --- ! 
     1522      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 
     1523 
     1524      ! --- non solar flux over ocean --- ! 
     1525      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1526      zqns_oce = 0._wp 
     1527      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
     1528 
     1529      ! --- heat flux associated with emp --- ! 
     1530      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
     1531      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
     1532         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
     1533         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
     1534      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
     1535         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
     1536 
     1537      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     1538      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1539 
     1540      ! --- total non solar flux --- ! 
     1541      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 
     1542 
     1543      ! --- in case both coupled/forced are active, we must mix values --- !  
     1544      IF( ln_mixcpl ) THEN 
     1545         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
     1546         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 
     1547         DO jl=1,jpl 
     1548            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1549         ENDDO 
     1550         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 
     1551         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:) 
     1552!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 
     1553      ELSE 
     1554         qns_tot  (:,:  ) = zqns_tot  (:,:  ) 
     1555         qns_oce  (:,:  ) = zqns_oce  (:,:  ) 
     1556         qns_ice  (:,:,:) = zqns_ice  (:,:,:) 
     1557         qprec_ice(:,:)   = zqprec_ice(:,:) 
     1558         qemp_oce (:,:)   = zqemp_oce (:,:) 
     1559      ENDIF 
     1560 
     1561      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1562 
     1563#else 
     1564 
     1565      ! clem: this formulation is certainly wrong... but better than it was... 
     1566      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
     1567         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1568         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST) 
     1569         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
     1570 
     1571     IF( ln_mixcpl ) THEN 
     1572         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1573         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:) 
     1574         DO jl=1,jpl 
     1575            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1576         ENDDO 
     1577      ELSE 
     1578         qns_tot(:,:  ) = zqns_tot(:,:  ) 
     1579         qns_ice(:,:,:) = zqns_ice(:,:,:) 
     1580      ENDIF 
     1581 
     1582#endif 
    12341583 
    12351584      !                                                      ! ========================= ! 
     
    12371586      !                                                      ! ========================= ! 
    12381587      CASE( 'oce only' ) 
    1239          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1588         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12401589      CASE( 'conservative' ) 
    1241          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1590         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12421591         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    1243             qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1592            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    12441593         ELSE 
    12451594            ! Set all category values equal for the moment 
    12461595            DO jl=1,jpl 
    1247                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1596               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12481597            ENDDO 
    12491598         ENDIF 
    1250          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1251          qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1599         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1600         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12521601      CASE( 'oce and ice' ) 
    1253          qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1602         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    12541603         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    12551604            DO jl=1,jpl 
    1256                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    1257                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1605               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1606               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    12581607            ENDDO 
    12591608         ELSE 
    12601609            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12611610            DO jl=1,jpl 
    1262                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1611               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1612               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12631613            ENDDO 
    12641614         ENDIF 
    12651615      CASE( 'mixed oce-ice' ) 
    1266          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1616         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12671617! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12681618!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12691619!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1270          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1620         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    12711621            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    12721622            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12731623      END SELECT 
    1274       IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1275          qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1624      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle 
     1625         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) ) 
    12761626         DO jl=1,jpl 
    1277             qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1627            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 
    12781628         ENDDO 
     1629      ENDIF 
     1630 
     1631      IF( ln_mixcpl ) THEN 
     1632         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1633         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:) 
     1634         DO jl=1,jpl 
     1635            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:) 
     1636         ENDDO 
     1637      ELSE 
     1638         qsr_tot(:,:  ) = zqsr_tot(:,:  ) 
     1639         qsr_ice(:,:,:) = zqsr_ice(:,:,:) 
    12791640      ENDIF 
    12801641 
     
    12841645      CASE ('coupled') 
    12851646         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    1286             dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1647            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    12871648         ELSE 
    12881649            ! Set all category values equal for the moment 
    12891650            DO jl=1,jpl 
    1290                dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1651               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
    12911652            ENDDO 
    12921653         ENDIF 
    12931654      END SELECT 
    1294  
     1655       
     1656      IF( ln_mixcpl ) THEN 
     1657         DO jl=1,jpl 
     1658            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 
     1659         ENDDO 
     1660      ELSE 
     1661         dqns_ice(:,:,:) = zdqns_ice(:,:,:) 
     1662      ENDIF 
     1663       
    12951664      !                                                      ! ========================= ! 
    12961665      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     
    13081677      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13091678 
    1310       CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1679      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1680      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
    13111681      ! 
    13121682      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
     
    13281698      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    13291699      INTEGER ::   isec, info   ! local integer 
     1700      REAL(wp) ::   zumax, zvmax 
    13301701      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    13311702      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     
    13441715      !                                                      ! ------------------------- ! 
    13451716      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    1346          SELECT CASE( sn_snd_temp%cldes) 
    1347          CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1348          CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
    1349             SELECT CASE( sn_snd_temp%clcat ) 
    1350             CASE( 'yes' )    
    1351                ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1352             CASE( 'no' ) 
    1353                ztmp3(:,:,:) = 0.0 
     1717          
     1718         IF ( nn_components == jp_iam_opa ) THEN 
     1719            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 
     1720         ELSE 
     1721            ! we must send the surface potential temperature  
     1722            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     1723            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     1724            ENDIF 
     1725            ! 
     1726            SELECT CASE( sn_snd_temp%cldes) 
     1727            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1728            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     1729               SELECT CASE( sn_snd_temp%clcat ) 
     1730               CASE( 'yes' )    
     1731                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1732               CASE( 'no' ) 
     1733                  ztmp3(:,:,:) = 0.0 
     1734                  DO jl=1,jpl 
     1735                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1736                  ENDDO 
     1737               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1738               END SELECT 
     1739            CASE( 'mixed oce-ice'        )    
     1740               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
    13541741               DO jl=1,jpl 
    1355                   ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1742                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    13561743               ENDDO 
    1357             CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1744            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13581745            END SELECT 
    1359          CASE( 'mixed oce-ice'        )    
    1360             ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    1361             DO jl=1,jpl 
    1362                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    1363             ENDDO 
    1364          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    1365          END SELECT 
     1746         ENDIF 
    13661747         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    13671748         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     
    13851766      !                                                      !  Ice fraction & Thickness !  
    13861767      !                                                      ! ------------------------- ! 
    1387       ! Send ice fraction field  
     1768      ! Send ice fraction field to atmosphere 
    13881769      IF( ssnd(jps_fice)%laction ) THEN 
    13891770         SELECT CASE( sn_snd_thick%clcat ) 
     
    13921773         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    13931774         END SELECT 
    1394          CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1775         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1776      ENDIF 
     1777       
     1778      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
     1779      IF( ssnd(jps_fice2)%laction ) THEN 
     1780         ztmp3(:,:,1) = fr_i(:,:) 
     1781         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 
    13951782      ENDIF 
    13961783 
     
    14401827         !                                                              i-1  i   i 
    14411828         !                                                               i      i+1 (for I) 
    1442          SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    1443          CASE( 'oce only'             )      ! C-grid ==> T 
    1444             DO jj = 2, jpjm1 
    1445                DO ji = fs_2, fs_jpim1   ! vector opt. 
    1446                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1447                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1448                END DO 
    1449             END DO 
    1450          CASE( 'weighted oce and ice' )    
    1451             SELECT CASE ( cp_ice_msh ) 
    1452             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1829         IF( nn_components == jp_iam_opa ) THEN 
     1830            zotx1(:,:) = un(:,:,1)   
     1831            zoty1(:,:) = vn(:,:,1)   
     1832         ELSE         
     1833            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
     1834            CASE( 'oce only'             )      ! C-grid ==> T 
    14531835               DO jj = 2, jpjm1 
    14541836                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1455                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1456                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
    1457                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1458                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1837                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     1838                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    14591839                  END DO 
    14601840               END DO 
    1461             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1462                DO jj = 2, jpjm1 
    1463                   DO ji = 2, jpim1   ! NO vector opt. 
    1464                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1465                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1466                      zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1467                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1468                      zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1469                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1841            CASE( 'weighted oce and ice' )    
     1842               SELECT CASE ( cp_ice_msh ) 
     1843               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1844                  DO jj = 2, jpjm1 
     1845                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1846                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1847                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
     1848                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1849                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1850                     END DO 
    14701851                  END DO 
    1471                END DO 
    1472             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1473                DO jj = 2, jpjm1 
    1474                   DO ji = 2, jpim1   ! NO vector opt. 
    1475                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1476                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1477                      zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1478                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1479                      zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1480                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1852               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1853                  DO jj = 2, jpjm1 
     1854                     DO ji = 2, jpim1   ! NO vector opt. 
     1855                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1856                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1857                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1858                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1859                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1860                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1861                     END DO 
    14811862                  END DO 
    1482                END DO 
     1863               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1864                  DO jj = 2, jpjm1 
     1865                     DO ji = 2, jpim1   ! NO vector opt. 
     1866                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1867                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1868                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1869                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1870                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1871                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1872                     END DO 
     1873                  END DO 
     1874               END SELECT 
     1875               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     1876            CASE( 'mixed oce-ice'        ) 
     1877               SELECT CASE ( cp_ice_msh ) 
     1878               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1879                  DO jj = 2, jpjm1 
     1880                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1881                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
     1882                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1883                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
     1884                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1885                     END DO 
     1886                  END DO 
     1887               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1888                  DO jj = 2, jpjm1 
     1889                     DO ji = 2, jpim1   ! NO vector opt. 
     1890                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1891                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1892                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1893                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1894                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1895                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1896                     END DO 
     1897                  END DO 
     1898               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1899                  DO jj = 2, jpjm1 
     1900                     DO ji = 2, jpim1   ! NO vector opt. 
     1901                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1902                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1903                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1904                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1905                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1906                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1907                     END DO 
     1908                  END DO 
     1909               END SELECT 
    14831910            END SELECT 
    1484             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
    1485          CASE( 'mixed oce-ice'        ) 
    1486             SELECT CASE ( cp_ice_msh ) 
    1487             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
    1488                DO jj = 2, jpjm1 
    1489                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1490                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
    1491                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1492                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
    1493                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    1494                   END DO 
    1495                END DO 
    1496             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1497                DO jj = 2, jpjm1 
    1498                   DO ji = 2, jpim1   ! NO vector opt. 
    1499                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1500                         &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1501                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1502                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1503                         &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1504                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1505                   END DO 
    1506                END DO 
    1507             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1508                DO jj = 2, jpjm1 
    1509                   DO ji = 2, jpim1   ! NO vector opt. 
    1510                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1511                         &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1512                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1513                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1514                         &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1515                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1516                   END DO 
    1517                END DO 
    1518             END SELECT 
    1519          END SELECT 
    1520          CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1911            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1912            ! 
     1913         ENDIF 
    15211914         ! 
    15221915         ! 
     
    15581951      ENDIF 
    15591952      ! 
     1953      ! 
     1954      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
     1955      !                                                        ! SSH 
     1956      IF( ssnd(jps_ssh )%laction )  THEN 
     1957         !                          ! removed inverse barometer ssh when Patm 
     1958         !                          forcing is used (for sea-ice dynamics) 
     1959         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     1960         ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     1961         ENDIF 
     1962         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 
     1963 
     1964      ENDIF 
     1965      !                                                        ! SSS 
     1966      IF( ssnd(jps_soce  )%laction )  THEN 
     1967         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 
     1968      ENDIF 
     1969      !                                                        ! first T level thickness  
     1970      IF( ssnd(jps_e3t1st )%laction )  THEN 
     1971         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     1972      ENDIF 
     1973      !                                                        ! Qsr fraction 
     1974      IF( ssnd(jps_fraqsr)%laction )  THEN 
     1975         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 
     1976      ENDIF 
     1977      ! 
     1978      !  Fields sent by SAS to OPA when OASIS coupling 
     1979      !                                                        ! Solar heat flux 
     1980      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 
     1981      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 
     1982      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 
     1983      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 
     1984      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 
     1985      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 
     1986      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 
     1987      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
     1988 
    15601989      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    15611990      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r5215 r5407  
    138138         IF      ( ksbc == jp_flx ) THEN 
    139139            CALL cice_sbc_force(kt) 
    140          ELSE IF ( ksbc == jp_cpl ) THEN 
     140         ELSE IF ( ksbc == jp_purecpl ) THEN 
    141141            CALL sbc_cpl_ice_flx( 1.0-fr_i  ) 
    142142         ENDIF 
     
    146146         CALL cice_sbc_out ( kt, ksbc ) 
    147147 
    148          IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1) 
     148         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
    149149 
    150150      ENDIF                                          ! End sea-ice time step only 
     
    187187 
    188188! Do some CICE consistency checks 
    189       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
     189      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    190190         IF ( calc_strair .OR. calc_Tsfc ) THEN 
    191191            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
     
    212212 
    213213      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    214       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
     214      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    215215         DO jl=1,ncat 
    216216            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     
    319319! forced and coupled case  
    320320 
    321       IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
     321      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    322322 
    323323         ztmpn(:,:,:)=0.0 
     
    587587      ELSE IF (ksbc == jp_core) THEN 
    588588         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    589       ELSE IF (ksbc == jp_cpl) THEN 
     589      ELSE IF (ksbc == jp_purecpl) THEN 
    590590! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    591591! This is currently as required with the coupling fields from the UM atmosphere 
     
    623623      ENDIF 
    624624! Take into account snow melting except for fully coupled when already in qns_tot 
    625       IF (ksbc == jp_cpl) THEN 
     625      IF (ksbc == jp_purecpl) THEN 
    626626         qsr(:,:)= qsr_tot(:,:) 
    627627         qns(:,:)= qns_tot(:,:) 
     
    658658 
    659659      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    660       IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
     660      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    661661         DO jl=1,ncat 
    662662            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4990 r5407  
    105105         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    106106 
    107          IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)          
     107         IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)          
    108108 
    109109         ! Flux and ice fraction computation 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5341 r5407  
    110110      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    111111      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled) 
     112      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
    112113      !!---------------------------------------------------------------------- 
    113114 
     
    115116 
    116117      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only 
     118 
    117119         !-----------------------!                                            
    118120         ! --- Bulk Formulae --- !                                            
     
    124126         t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )   
    125127         !                                                                                       
    126          ! Ice albedo 
    127          CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    128          CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    129  
    130          ! CORE and COUPLED bulk formulations 
    131          SELECT CASE( kblk ) 
    132          CASE( jp_core , jp_cpl ) 
    133  
    134             ! albedo depends on cloud fraction because of non-linear spectral effects 
    135             zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    136             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    137             ! (zalb_ice) is computed within the bulk routine 
    138              
    139          END SELECT 
     128!!clem         ! Ice albedo 
     129!!clem         CALL wrk_@lloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     130!!clem         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     131!! 
     132!!         ! CORE and COUPLED bulk formulations 
     133!!         SELECT CASE( kblk ) 
     134!!         CASE( jp_core , jp_purecpl ) 
     135!!            ! albedo depends on cloud fraction because of non-linear spectral effects 
     136!!            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     137!!            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     138!!            ! (zalb_ice) is computed within the bulk routine 
     139!!clem         END SELECT 
    140140          
    141141         ! Mask sea ice surface temperature (set to rt0 over land) 
     
    154154         SELECT CASE( kblk ) 
    155155         CASE( jp_clio )                                       ! CLIO bulk formulation 
    156             CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               & 
    157                &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   & 
    158                &                      qla_ice    , dqns_ice   , dqla_ice  ,               & 
    159                &                      tprecip    , sprecip    ,                           & 
    160                &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  ) 
    161             !          
    162             IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    163                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     156!!clem            CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               & 
     157!!               &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   & 
     158!!               &                      qla_ice    , dqns_ice   , dqla_ice  ,               & 
     159!!               &                      tprecip    , sprecip    ,                           & 
     160!!               &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  ) 
     161!!            !          
     162!!            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     163!!               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     164            CALL blk_ice_clio_tau 
    164165 
    165166         CASE( jp_core )                                       ! CORE bulk formulation 
    166             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    167                &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    168                &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
    169                &                      tprecip   , sprecip   ,                            & 
    170                &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
    171                ! 
    172             IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    173                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     167!!clem            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
     168!!clem               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
     169!!clem               &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
     170!!clem               &                      tprecip   , sprecip   ,                            & 
     171!!clem               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
     172!!clem            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     173!!clem               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     174            CALL blk_ice_core_tau 
    174175            ! 
    175          CASE ( jp_cpl ) 
     176         CASE ( jp_purecpl ) 
    176177             
    177178            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
     
    179180         END SELECT 
    180181          
    181          !------------------------------! 
    182          ! --- LIM-3 main time-step --- ! 
    183          !------------------------------! 
     182         IF( ln_mixcpl) THEN 
     183            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
     184            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     185            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     186            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     187            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     188         ENDIF 
     189 
     190         !                                           !----------------------! 
     191         !                                           ! LIM-3  time-stepping ! 
     192         !                                           !----------------------! 
     193         !  
    184194         numit = numit + nn_fsbc                     ! Ice model time step 
    185195         !                                                    
     
    220230         phicif(:,:)  = vt_i(:,:) 
    221231          
     232         ! Ice albedo 
     233         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     234         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     235  
    222236         SELECT CASE( kblk ) 
    223          CASE ( jp_cpl ) 
    224             CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
     237         CASE( jp_clio )                                       ! CLIO bulk formulation 
     238            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     239            ! (zalb_ice) is computed within the bulk routine 
     240!           CALL blk_ice_clio_flx( t_su , zalb_cs, zalb_os  , zalb_ice, qns_ice   , qsr_ice   ,    & 
     241!              &                      qla_ice, dqns_ice   , dqla_ice  , tprecip, sprecip    ,  & 
     242!              &                      fr1_i0     , fr2_i0     , jpl  ) 
     243!           !          
     244            CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 
     245            IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     246            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     247               &                                           dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     248 
     249         CASE( jp_core )                                       ! CORE bulk formulation 
     250            ! albedo depends on cloud fraction because of non-linear spectral effects 
     251            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     252            CALL blk_ice_core_flx( t_su, zalb_ice ) 
     253            IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     254            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     255               &                                           dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     256 
     257         CASE ( jp_purecpl ) 
     258            ! albedo depends on cloud fraction because of non-linear spectral effects 
     259            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     260            CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
    225261            IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    226                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     262               &                                           dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    227263            ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 
    228             qla_ice  (:,:,:) = 0._wp 
    229             dqla_ice (:,:,:) = 0._wp 
     264            evap_ice  (:,:,:) = 0._wp 
     265            devap_ice (:,:,:) = 0._wp 
     266 
    230267         END SELECT 
     268         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     269