Changeset 5407


Ignore:
Timestamp:
2015-06-11T21:13:22+02:00 (6 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