New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5407 for trunk/NEMOGCM – NEMO

Changeset 5407 for trunk/NEMOGCM


Ignore:
Timestamp:
2015-06-11T21:13:22+02:00 (9 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 
    231270         ! 
    232271         CALL lim_thd( kt )                         ! Ice thermodynamics  
    … …  
    247286         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
    248287         ! 
    249          CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    250288         ! 
    251289      ENDIF   ! End sea-ice time step only 
    … …  
    476514    
    477515   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice,   & 
    478          &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 
     516         &                          pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    479517      !!--------------------------------------------------------------------- 
    480518      !!                  ***  ROUTINE ice_lim_flx  *** 
    … …  
    494532      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux 
    495533      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity 
    496       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqla_ice   ! latent heat flux 
    497       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdql_ice   ! latent heat flux sensitivity 
     534      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation 
     535      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity 
    498536      ! 
    499537      INTEGER  ::   jl      ! dummy loop index 
    … …  
    504542      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories 
    505543      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories 
    506       REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m   ! Mean latent heat flux over all categories 
     544      REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories 
    507545      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
    508       REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m   ! Mean d(qla)/dT over all categories 
     546      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 
    509547      !!---------------------------------------------------------------------- 
    510548 
    … …  
    514552      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
    515553      CASE( 0 , 1 ) 
    516          CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
     554         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    517555         ! 
    518556         z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
    519557         z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
    520558         z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
    521          z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) ) 
    522          z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) ) 
     559         z_evap_m(:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 
     560         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 
    523561         DO jl = 1, jpl 
    524562            pdqn_ice(:,:,jl) = z_dqn_m(:,:) 
    525             pdql_ice(:,:,jl) = z_dql_m(:,:) 
     563            pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    526564         END DO 
    527565         ! 
    … …  
    529567            pqns_ice(:,:,jl) = z_qns_m(:,:) 
    530568            pqsr_ice(:,:,jl) = z_qsr_m(:,:) 
    531             pqla_ice(:,:,jl) = z_qla_m(:,:) 
     569            pevap_ice(:,:,jl) = z_evap_m(:,:) 
    532570         END DO 
    533571         ! 
    534          CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
     572         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    535573      END SELECT 
    536574 
    … …  
    543581         DO jl = 1, jpl 
    544582            pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
    545             pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
     583            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
    546584            pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
    547585         END DO 
    … …  
    593631      wfx_spr(:,:) = 0._wp   ;    
    594632       
    595       hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
    596633      hfx_thd(:,:) = 0._wp   ;    
    597634      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
    … …  
    610647       
    611648   END SUBROUTINE sbc_lim_diag0 
    612        
     649 
     650      
    613651   FUNCTION fice_cell_ave ( ptab ) 
    614652      !!-------------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r5385 r5407  
    101101      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo 
    102102      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K) 
     103      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice  
    103104      !!---------------------------------------------------------------------- 
    104  
    105       CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    106105 
    107106      IF( kt == nit000 ) THEN 
    … …  
    124123         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 
    125124# endif 
     125 
     126         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     127         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
     128 
    126129         !  Bulk Formulea ! 
    127130         !----------------! 
    … …  
    132135               DO ji = 2, jpi   ! NO vector opt. possible 
    133136                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) & 
    134                      &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     137                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    135138                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) & 
    136                      &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     139                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    137140               END DO 
    138141            END DO 
    … …  
    158161 
    159162         SELECT CASE( ksbc ) 
    160          CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     163         CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations 
    161164 
    162165            ! albedo depends on cloud fraction because of non-linear spectral effects 
    … …  
    182185         SELECT CASE( ksbc ) 
    183186         CASE( jp_clio )           ! CLIO bulk formulation 
    184             CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    185                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    186                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    187                &                      tprecip    , sprecip    ,                         & 
    188                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     187!           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
     188!              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
     189!              &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
     190!              &                      tprecip    , sprecip    ,                         & 
     191!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     192            CALL blk_ice_clio_tau 
     193            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 
    189194 
    190195         CASE( jp_core )           ! CORE bulk formulation 
    191             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    192                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    193                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    194                &                      tprecip    , sprecip    ,                         & 
    195                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    196  
    197          CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
     196            CALL blk_ice_core_tau 
     197            CALL blk_ice_core_flx( zsist, zalb_ice ) 
     198 
     199         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    198200            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    199201         END SELECT 
     202          
     203         IF( ln_mixcpl) THEN 
     204            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     205            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     206            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     207         ENDIF 
    200208 
    201209         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point 
    … …  
    227235         END IF 
    228236         !                                             ! Ice surface fluxes in coupled mode  
    229          IF( ksbc == jp_cpl )   THEN 
     237         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations 
    230238            a_i(:,:,1)=fr_i 
    231239            CALL sbc_cpl_ice_flx( frld,                                              & 
    … …  
    249257         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt ) 
    250258# endif 
     259         ! 
     260         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     261         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    251262         ! 
    252263      ENDIF                                    ! End sea-ice time step only 
    … …  
    260271      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    261272      ! 
    262       CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    263       ! 
    264273   END SUBROUTINE sbc_ice_lim_2 
    265274 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5385 r5407  
    3939   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    4040   USE sbccpl           ! surface boundary condition: coupled florulation 
     41   USE cpl_oasis3       ! OASIS routines for coupling 
    4142   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4243   USE sbcrnf           ! surface boundary condition: runoffs 
    … …  
    8485      INTEGER ::   icpt   ! local integer 
    8586      !! 
    86       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    87          &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    88          &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
     87      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   & 
     88         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   & 
     89         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   & 
     90         &             nn_lsm    , nn_limflx , nn_components, ln_cpl 
    8991      INTEGER  ::   ios 
     92      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
     93      LOGICAL  ::   ll_purecpl 
    9094      !!---------------------------------------------------------------------- 
    9195 
    … …  
    115119          nn_ice      =   0 
    116120      ENDIF 
    117       
     121 
    118122      IF(lwp) THEN               ! Control print 
    119123         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    … …  
    125129         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    126130         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    127          WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     131         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl 
     132         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl 
     133         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis 
     134         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
    128135         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    129136         WRITE(numout,*) '           Misc. options of sbc : ' 
    … …  
    152159      END SELECT 
    153160      ! 
     161      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   & 
     162         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     163      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   & 
     164         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
     165      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
     166         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     167      IF ( ln_cpl .AND. .NOT. lk_oasis )    & 
     168         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
     169      IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
     170         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
     171      IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
     172         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
     173      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
     174         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
     175 
    154176      !                              ! allocate sbc arrays 
    155177      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 
    … …  
    170192         fwfisf_b(:,:) = 0.0_wp 
    171193      END IF 
    172       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
     194      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 
    173195 
    174196      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
    … …  
    180202 
    181203      !                                            ! restartability    
    182       IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    183           MOD( nstock             , nn_fsbc) /= 0 ) THEN  
    184          WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
    185             &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
    186          CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
    187       ENDIF 
    188       ! 
    189       IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
    190          &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    191       ! 
    192       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     204      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
    193205         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    194       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    195          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
     206      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
     207         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 
    196208      IF( nn_ice == 4 .AND. lk_agrif )   & 
    197209         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
    … …  
    200212      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
    201213         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
    202       IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     214      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
    203215         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    204       IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     216      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   & 
    205217         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
    206218 
    207219      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    208220 
    209       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   & 
     221      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   & 
    210222         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
    211223       
    212       IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    213          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    214  
    215224      IF ( ln_wave ) THEN 
    216225      !Activated wave module but neither drag nor stokes drift activated 
    … …  
    227236      ENDIF  
    228237      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
     238      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
     239      ! 
    229240      icpt = 0 
    230       IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    231       IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    232       IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    233       IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    234       IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    235       IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    236       IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
    237       IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
     241      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
     242      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
     243      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
     244      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation 
     245      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
     246      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
     247      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
     248      IF( nn_components == jp_iam_opa )   & 
     249         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
     250      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations 
    238251      ! 
    239252      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
    … …  
    246259      IF(lwp) THEN 
    247260         WRITE(numout,*) 
    248          IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    249          IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
    250          IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
    251          IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
    252          IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
    253          IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
    254          IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
    255          IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
    256       ENDIF 
    257       ! 
     261         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     262         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation' 
     263         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation' 
     264         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation' 
     265         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation' 
     266         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation' 
     267         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation' 
     268         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation' 
     269         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis' 
     270         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation' 
     271         IF( nn_components/= jp_iam_nemo )  & 
     272            &                       WRITE(numout,*) '              + OASIS coupled SAS' 
     273      ENDIF 
     274      ! 
     275      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     276      !                                                     !                                            (2) the use of nn_fsbc 
     277 
     278!     nn_fsbc initialization if OPA-SAS coupling via OASIS 
     279!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
     280      IF ( nn_components /= jp_iam_nemo ) THEN 
     281 
     282         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
     283         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 
     284         ! 
     285         IF(lwp)THEN 
     286            WRITE(numout,*) 
     287            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
     288            WRITE(numout,*) 
     289         ENDIF 
     290      ENDIF 
     291 
     292      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
     293          MOD( nstock             , nn_fsbc) /= 0 ) THEN  
     294         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
     295            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
     296         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
     297      ENDIF 
     298      ! 
     299      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
     300         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
     301      ! 
     302      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
     303         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     304 
    258305                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    259306      ! 
    … …  
    265312 
    266313      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    267       ! 
    268       IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
    269314       
    270315   END SUBROUTINE sbc_init 
    … …  
    310355                                                         ! (caution called before sbc_ssm) 
    311356      ! 
    312       CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    313       !                                                  ! averaged over nf_sbc time-step 
     357      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     358      !                                                        ! averaged over nf_sbc time-step 
    314359 
    315360      IF (ln_wave) CALL sbc_wave( kt ) 
    … …  
    322367      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    323368      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    324       CASE( jp_core  )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    325       CASE( jp_cpl   )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     369      CASE( jp_core  )    
     370         IF( nn_components == jp_iam_sas ) & 
     371            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
     372                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     373                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
     374      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     375                                                                        ! 
    326376      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     377      CASE( jp_none  )  
     378         IF( nn_components == jp_iam_opa ) & 
     379                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    327380      CASE( jp_esopa )                                 
    328381                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    … …  
    334387      END SELECT 
    335388 
     389      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     390 
     391 
    336392      !                                            !==  Misc. Options  ==! 
    337393       
    … …  
    356412      !                                                           ! (update freshwater fluxes) 
    357413!RBbug do not understand why see ticket 667 
    358       !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 
     414!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
     415      CALL lbc_lnk( emp, 'T', 1. ) 
    359416      ! 
    360417      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    … …  
    397454         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    398455         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    399          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
     456         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx ) 
    400457      ENDIF 
    401458 
    … …  
    412469         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    413470         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    414          IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     471         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
    415472         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
    416473         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5385 r5407  
    3232 
    3333   PUBLIC   sbc_rnf       ! routine call in sbcmod module 
    34    PUBLIC   sbc_rnf_div   ! routine called in sshwzv module 
     34   PUBLIC   sbc_rnf_div   ! routine called in divcurl module 
    3535   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module 
    3636   PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM) 
    … …  
    4444   LOGICAL           , PUBLIC ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file 
    4545   LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file 
    46    LOGICAL           , PUBLIC ::   ln_rnf_emp      !: runoffs into a file to be read or already into precipitation 
    4746   TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read 
    4847   TYPE(FLD_N)       , PUBLIC ::   sn_cnf          !: information about the runoff mouth file to be read 
    … …  
    5453   REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s] 
    5554   REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff 
     55 
     56   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis 
    5657 
    5758   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
    … …  
    117118      ENDIF 
    118119 
    119       !                                                   !-------------------! 
    120       IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   ! 
    121          !                                                !-------------------! 
    122          ! 
    123                              CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
    124          IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
    125          IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    126          ! 
    127          ! Runoff reduction only associated to the ORCA2_LIM configuration 
    128          ! when reading the NetCDF file runoff_1m_nomask.nc 
    129          IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN 
    130             WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
    131                sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
     120      !                                            !-------------------! 
     121      !                                            !   Update runoff   ! 
     122      !                                            !-------------------! 
     123      ! 
     124      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
     125      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
     126      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
     127      ! 
     128      ! Runoff reduction only associated to the ORCA2_LIM configuration 
     129      ! when reading the NetCDF file runoff_1m_nomask.nc 
     130      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN 
     131         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
     132            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
     133         END WHERE 
     134      ENDIF 
     135      ! 
     136      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     137         ! 
     138         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
     139         ! 
     140         !                                                     ! set temperature & salinity content of runoffs 
     141         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
     142            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     143            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
     144               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    132145            END WHERE 
    133          ENDIF 
    134          ! 
    135          IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    136             ! 
    137             rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
    138             ! 
    139             !                                                     ! set temperature & salinity content of runoffs 
    140             IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    141                rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    142                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
    143                    rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    144                END WHERE 
    145                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
    146                    ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 
    147                    rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 
    148                END WHERE 
    149             ELSE                                                        ! use SST as runoffs temperature 
    150                rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    151             ENDIF 
    152             !                                                           ! use runoffs salinity data 
    153             IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    154             !                                                           ! else use S=0 for runoffs (done one for all in the init) 
    155             IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1 
    156             IF(lk_mpp) CALL mpp_sum(z_err) 
    157             IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' ) 
    158             ! 
    159             CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
    160          ENDIF 
    161          ! 
    162       ENDIF 
    163       ! 
     146            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
     147               ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 
     148               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 
     149            END WHERE 
     150         ELSE                                                        ! use SST as runoffs temperature 
     151            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
     152         ENDIF 
     153         !                                                           ! use runoffs salinity data 
     154         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     155         !                                                           ! else use S=0 for runoffs (done one for all in the init) 
     156         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
     157      ENDIF 
     158      ! 
     159      !                                                ! ---------------------------------------- ! 
    164160      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    165161         !                                             ! ---------------------------------------- ! 
    … …  
    172168         ELSE                                                   !* no restart: set from nit000 values 
    173169            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    174              rnf_b    (:,:  ) = rnf    (:,:  ) 
    175              rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     170            rnf_b    (:,:  ) = rnf    (:,:  ) 
     171            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    176172         ENDIF 
    177173      ENDIF 
    … …  
    187183         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 
    188184      ENDIF 
     185      ! 
    189186      CALL wrk_dealloc( jpi,jpj, ztfrz) 
    190187      ! 
    … …  
    265262      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf 
    266263      ! 
    267       NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
     264      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    268265         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
    269266         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     & 
    … …  
    290287         WRITE(numout,*) '~~~~~~~ ' 
    291288         WRITE(numout,*) '   Namelist namsbc_rnf' 
    292          WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp 
    293289         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth 
    294290         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf 
    … …  
    296292         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact 
    297293      ENDIF 
    298       ! 
    299294      !                                   ! ================== 
    300295      !                                   !   Type of runoff 
    … …  
    303298      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 
    304299      ! 
    305       IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==! 
    306          IF(lwp) WRITE(numout,*) 
    307          IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations' 
    308          IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal .OR. ln_rnf_depth_ini ) THEN 
    309            CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
    310            ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE.  ;   ln_rnf_depth_ini = .FALSE. 
    311          ENDIF 
    312          ! 
    313       ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==! 
    314          ! 
     300      IF( .NOT. l_rnfcpl ) THEN                     
    315301         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    316302         IF(lwp) WRITE(numout,*) 
    … …  
    321307         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   ) 
    322308         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
    323          !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print 
    324309         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 
    325          ! 
    326          IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
    327             IF(lwp) WRITE(numout,*) 
    328             IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
    329             ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
    330             IF( ierror > 0 ) THEN 
    331                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN 
    332             ENDIF 
    333             ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
    334             IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
    335             CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
    336          ENDIF 
    337          ! 
    338          IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
    339             IF(lwp) WRITE(numout,*) 
    340             IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
    341             ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
    342             IF( ierror > 0 ) THEN 
    343                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN 
    344             ENDIF 
    345             ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
    346             IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
    347             CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
    348          ENDIF 
    349          ! 
    350          IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
    351             IF(lwp) WRITE(numout,*) 
    352             IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
    353             rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    354             IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
    355                IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
    356             ENDIF  
    357             CALL iom_open ( rn_dep_file, inum )                           ! open file 
    358             CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
    359             CALL iom_close( inum )                                        ! close file 
    360             ! 
    361             nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    362             DO jj = 1, jpj 
    363                DO ji = 1, jpi 
    364                   IF( h_rnf(ji,jj) > 0._wp ) THEN 
    365                      jk = 2 
    366                      DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO 
    367                      nk_rnf(ji,jj) = jk 
    368                   ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
    369                   ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
    370                   ELSE 
    371                      CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
    372                      WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
    373                   ENDIF 
     310      ENDIF 
     311      ! 
     312      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
     313         IF(lwp) WRITE(numout,*) 
     314         IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
     315         ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
     316         IF( ierror > 0 ) THEN 
     317            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN 
     318         ENDIF 
     319         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
     320         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
     321         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
     322      ENDIF 
     323      ! 
     324      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
     325         IF(lwp) WRITE(numout,*) 
     326         IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
     327         ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
     328         IF( ierror > 0 ) THEN 
     329            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN 
     330         ENDIF 
     331         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
     332         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
     333         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
     334      ENDIF 
     335      ! 
     336      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
     337         IF(lwp) WRITE(numout,*) 
     338         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
     339         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
     340         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
     341            IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
     342         ENDIF 
     343         CALL iom_open ( rn_dep_file, inum )                           ! open file 
     344         CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
     345         CALL iom_close( inum )                                        ! close file 
     346         ! 
     347         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
     348         DO jj = 1, jpj 
     349            DO ji = 1, jpi 
     350               IF( h_rnf(ji,jj) > 0._wp ) THEN 
     351                  jk = 2 
     352                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
     353                  END DO 
     354                  nk_rnf(ji,jj) = jk 
     355               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
     356               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     357               ELSE 
     358                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
     359                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
     360               ENDIF 
     361            END DO 
     362         END DO 
     363         DO jj = 1, jpj                                ! set the associated depth 
     364            DO ji = 1, jpi 
     365               h_rnf(ji,jj) = 0._wp 
     366               DO jk = 1, nk_rnf(ji,jj) 
     367                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    374368               END DO 
    375369            END DO 
    376             DO jj = 1, jpj                                ! set the associated depth 
    377                DO ji = 1, jpi 
    378                   h_rnf(ji,jj) = 0._wp 
    379                   DO jk = 1, nk_rnf(ji,jj) 
    380                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
     370         END DO 
     371         ! 
     372      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface 
     373         ! 
     374         IF(lwp) WRITE(numout,*) 
     375         IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff' 
     376         IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
     377         IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
     378         IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
     379 
     380         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
     381         CALL iom_gettime( inum, zrec, kntime=nbrec) 
     382         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) ) 
     383         DO jm = 1, nbrec 
     384            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 
     385         END DO 
     386         CALL iom_close( inum ) 
     387         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time 
     388         DEALLOCATE( zrnfcl ) 
     389         ! 
     390         h_rnf(:,:) = 1. 
     391         ! 
     392         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff) 
     393         ! 
     394         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs 
     395         ! 
     396         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin 
     397            DO ji = 1, jpi 
     398               IF( zrnf(ji,jj) > 0._wp ) THEN 
     399                  jk = mbkt(ji,jj) 
     400                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 
     401               ENDIF 
     402            END DO 
     403         END DO 
     404         ! 
     405         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
     406         DO jj = 1, jpj 
     407            DO ji = 1, jpi 
     408               IF( zrnf(ji,jj) > 0._wp ) THEN 
     409                  jk = 2 
     410                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
    381411                  END DO 
     412                  nk_rnf(ji,jj) = jk 
     413               ELSE 
     414                  nk_rnf(ji,jj) = 1 
     415               ENDIF 
     416            END DO 
     417         END DO 
     418         ! 
     419         DEALLOCATE( zrnf ) 
     420         ! 
     421         DO jj = 1, jpj                                ! set the associated depth 
     422            DO ji = 1, jpi 
     423               h_rnf(ji,jj) = 0._wp 
     424               DO jk = 1, nk_rnf(ji,jj) 
     425                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    382426               END DO 
    383427            END DO 
    384             ! 
    385          ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface 
    386             ! 
    387             IF(lwp) WRITE(numout,*) 
    388             IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff' 
    389             IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
    390             IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
    391             IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
    392  
    393             CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
    394             CALL iom_gettime( inum, zrec, kntime=nbrec) 
    395             ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) ) 
    396             DO jm = 1, nbrec 
    397                CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 
    398             END DO 
    399             CALL iom_close( inum ) 
    400             zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time 
    401             DEALLOCATE( zrnfcl ) 
    402             ! 
    403             h_rnf(:,:) = 1. 
    404             ! 
    405             zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff) 
    406             ! 
    407             WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs 
    408             ! 
    409             DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin 
    410                DO ji = 1, jpi 
    411                   IF( zrnf(ji,jj) > 0._wp ) THEN 
    412                      jk = mbkt(ji,jj) 
    413                      h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 
    414                   ENDIF 
    415                END DO 
    416             END DO 
    417             ! 
    418             nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
    419             DO jj = 1, jpj 
    420                DO ji = 1, jpi 
    421                    IF( zrnf(ji,jj) > 0._wp ) THEN 
    422                      jk = 2 
    423                      DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO 
    424                      nk_rnf(ji,jj) = jk 
    425                    ELSE 
    426                      nk_rnf(ji,jj) = 1 
    427                    ENDIF 
    428                 END DO 
    429             END DO 
    430             ! 
    431             DEALLOCATE( zrnf ) 
    432             ! 
    433             DO jj = 1, jpj                                ! set the associated depth 
    434                DO ji = 1, jpi 
    435                   h_rnf(ji,jj) = 0._wp 
    436                   DO jk = 1, nk_rnf(ji,jj) 
    437                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    438                   END DO 
    439                END DO 
    440             END DO 
    441             ! 
    442             IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff 
    443                IF(lwp) WRITE(numout,*) '              create runoff depht file' 
    444                CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
    445                CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 
    446                CALL iom_close ( inum ) 
    447             ENDIF 
    448          ELSE                                       ! runoffs applied at the surface 
    449             nk_rnf(:,:) = 1 
    450             h_rnf (:,:) = fse3t(:,:,1) 
    451          ENDIF 
    452          ! 
     428         END DO 
     429         ! 
     430         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff 
     431            IF(lwp) WRITE(numout,*) '              create runoff depht file' 
     432            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     433            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 
     434            CALL iom_close ( inum ) 
     435         ENDIF 
     436      ELSE                                       ! runoffs applied at the surface 
     437         nk_rnf(:,:) = 1 
     438         h_rnf (:,:) = fse3t(:,:,1) 
    453439      ENDIF 
    454440      ! 
    … …  
    471457         IF( rn_hrnf > 0._wp ) THEN 
    472458            nkrnf = 2 
    473             DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO 
     459            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1 
     460            END DO 
    474461            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
    475462         ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r5120 r5407  
    5858      REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
    5959      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 
    60       REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep 
    6160      !!--------------------------------------------------------------------- 
    62        
     61 
    6362      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
    6463      DO jj = 1, jpj 
    … …  
    6867         END DO 
    6968      END DO 
    70       zub(:,:)        = ub (:,:,1       ) 
    71       zvb(:,:)        = vb (:,:,1       ) 
    72       ! 
    73       IF( lk_vvl ) THEN 
    74          zdep(:,:) = fse3t_n(:,:,1) 
    75       ENDIF 
    76       !                                                   ! ---------------------------------------- ! 
     69      ! 
    7770      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    7871         !                                                ! ---------------------------------------- ! 
    79          ssu_m(:,:) = zub(:,:) 
    80          ssv_m(:,:) = zvb(:,:) 
     72         ssu_m(:,:) = ub(:,:,1) 
     73         ssv_m(:,:) = vb(:,:,1) 
    8174         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    8275         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
    … …  
    8881         ENDIF 
    8982         ! 
    90          IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:) 
     83         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     84         ! 
     85         frq_m(:,:) = fraqsr_1lev(:,:) 
    9186         ! 
    9287      ELSE 
    … …  
    9792            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
    9893            zcoef = REAL( nn_fsbc - 1, wp ) 
    99             ssu_m(:,:) = zcoef * zub(:,:) 
    100             ssv_m(:,:) = zcoef * zvb(:,:) 
     94            ssu_m(:,:) = zcoef * ub(:,:,1) 
     95            ssv_m(:,:) = zcoef * vb(:,:,1) 
    10196            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    10297            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
    … …  
    108103            ENDIF 
    109104            ! 
    110             IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:) 
     105            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 
     106            ! 
     107            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
    111108            !                                             ! ---------------------------------------- ! 
    112109         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    … …  
    117114            sss_m(:,:) = 0.e0 
    118115            ssh_m(:,:) = 0.e0 
    119             IF( lk_vvl )   fse3t_m(:,:) = 0.e0 
     116            IF( lk_vvl )   e3t_m(:,:) = 0.e0 
     117            frq_m(:,:) = 0.e0 
    120118         ENDIF 
    121119         !                                                ! ---------------------------------------- ! 
    122120         !                                                !        Cumulate at each time step        ! 
    123121         !                                                ! ---------------------------------------- ! 
    124          ssu_m(:,:) = ssu_m(:,:) + zub(:,:) 
    125          ssv_m(:,:) = ssv_m(:,:) + zvb(:,:) 
     122         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
     123         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    126124         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    127125         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
    … …  
    133131         ENDIF 
    134132         ! 
    135          IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 
     133         IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 
     134         ! 
     135         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:) 
    136136 
    137137         !                                                ! ---------------------------------------- ! 
    … …  
    144144            ssv_m(:,:) = ssv_m(:,:) * zcoef           ! 
    145145            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m] 
    146             IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     146            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     147            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    147148            ! 
    148149         ENDIF 
    … …  
    161162            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  ) 
    162163            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
    163             IF( lk_vvl ) THEN 
    164                CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m'  , fse3t_m(:,:)  ) 
    165             END IF 
    166             ! 
    167          ENDIF 
    168          ! 
     164            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
     165            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  ) 
     166            ! 
     167         ENDIF 
     168         ! 
     169      ENDIF 
     170      ! 
     171      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   ! 
     172         CALL iom_put( 'ssu_m', ssu_m ) 
     173         CALL iom_put( 'ssv_m', ssv_m ) 
     174         CALL iom_put( 'sst_m', sst_m ) 
     175         CALL iom_put( 'sss_m', sss_m ) 
     176         CALL iom_put( 'ssh_m', ssh_m ) 
     177         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m ) 
     178         CALL iom_put( 'frq_m', frq_m ) 
    169179      ENDIF 
    170180      ! 
    … …  
    202212            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point) 
    203213            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point) 
    204             IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) ) 
     214            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 
     215            ! fraction of solar net radiation absorbed in 1st T level 
     216            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 
     217               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
     218            ELSE 
     219               frq_m(:,:) = 1._wp   ! default definition 
     220            ENDIF 
    205221            ! 
    206222            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs 
    … …  
    213229               sss_m(:,:) = zcoef * sss_m(:,:) 
    214230               ssh_m(:,:) = zcoef * ssh_m(:,:) 
    215                IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:) 
     231               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:) 
     232               frq_m(:,:) = zcoef * frq_m(:,:) 
    216233            ELSE 
    217234               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file' 
    … …  
    220237      ENDIF 
    221238      ! 
     239      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate 
     240         ! 
     241         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays' 
     242         ssu_m(:,:) = ub(:,:,1) 
     243         ssv_m(:,:) = vb(:,:,1) 
     244         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     245         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
     246         ENDIF 
     247         sss_m(:,:) = tsn(:,:,1,jp_sal) 
     248         ssh_m(:,:) = sshn(:,:) 
     249         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     250         frq_m(:,:) = 1._wp 
     251         ! 
     252      ENDIF 
     253      ! 
    222254   END SUBROUTINE sbc_ssm_init 
    223255 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5329 r5407  
    7474   PUBLIC   eos_init       ! called by istate module 
    7575 
    76    !                                          !!* Namelist (nameos) * 
    77    INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    78    LOGICAL , PUBLIC ::   ln_useCT  = .FALSE. ! determine if eos_pt_from_ct is used to compute sst_m 
     76   !                                !!* Namelist (nameos) * 
     77   INTEGER , PUBLIC ::   nn_eos     ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     78   LOGICAL , PUBLIC ::   ln_useCT  ! determine if eos_pt_from_ct is used to compute sst_m 
    7979 
    8080   !                                   !!!  simplified eos coefficients 
    … …  
    12521252            WRITE(numout,*) '             model uses Conservative Temperature' 
    12531253            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     1254         ELSE 
     1255            WRITE(numout,*) '             model does not use Conservative Temperature' 
    12541256         ENDIF 
    12551257      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4990 r5407  
    3232   USE wrk_nemo       ! Memory Allocation 
    3333   USE timing         ! Timing 
    34    USE sbc_ice, ONLY : lk_lim3 
    3534 
    3635   IMPLICIT NONE 
    … …  
    3837 
    3938   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T) 
    40    PUBLIC   tra_qsr_init  ! routine called by opa.F90 
     39   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90 
    4140 
    4241   !                                 !!* Namelist namtra_qsr: penetrative solar radiation 
    … …  
    5049   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    5150   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
    52     
     51  
    5352   ! Module variables 
    5453   REAL(wp) ::   xsi0r                           !: inverse of rn_si0 
    … …  
    165164         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution 
    166165         ! clem: store attenuation coefficient of the first ocean level 
    167          IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     166         IF ( ln_qsr_ice ) THEN 
    168167            DO jj = 1, jpj 
    169168               DO ji = 1, jpi 
    170169                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
    171170                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
     171                  ELSE 
     172                     fraqsr_1lev(ji,jj) = 1. 
    172173                  ENDIF 
    173174               END DO 
    … …  
    233234               END DO 
    234235               ! clem: store attenuation coefficient of the first ocean level 
    235                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     236               IF ( ln_qsr_ice ) THEN 
    236237                  DO jj = 1, jpj 
    237238                     DO ji = 1, jpi 
    … …  
    256257               END DO 
    257258               ! clem: store attenuation coefficient of the first ocean level 
    258                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     259               IF ( ln_qsr_ice ) THEN 
    259260                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    260261               ENDIF 
    … …  
    279280               END DO 
    280281               ! clem: store attenuation coefficient of the first ocean level 
    281                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     282               IF ( ln_qsr_ice ) THEN 
    282283                  DO jj = 1, jpj 
    283284                     DO ji = 1, jpi 
    … …  
    298299               END DO 
    299300               ! clem: store attenuation coefficient of the first ocean level 
    300                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     301               IF ( ln_qsr_ice ) THEN 
    301302                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    302303               ENDIF 
    … …  
    324325            &                    'at it= ', kt,' date= ', ndastp 
    325326         IF(lwp) WRITE(numout,*) '~~~~' 
    326          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 
     327         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      ) 
     328         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm  
    327329         ! 
    328330      ENDIF 
    … …  
    379381      ! 
    380382      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    381       ! 
    382       ! Default value for fraqsr_1lev 
    383       IF( .NOT. ln_rstart ) THEN 
    384          fraqsr_1lev(:,:) = 1._wp 
    385       ENDIF 
    386383      ! 
    387384      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
    … …  
    412409         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    413410         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
    414          WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice     
    415411      ENDIF 
    416412 
    … …  
    564560      ENDIF 
    565561      ! 
     562      ! initialisation of fraqsr_1lev used in sbcssm 
     563      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 
     564         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  ) 
     565      ELSE 
     566         fraqsr_1lev(:,:) = 1._wp   ! default definition 
     567      ENDIF 
     568      ! 
    566569      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )  
    567570      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r5120 r5407  
    761761      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    762762      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
    763       IF( nn_etau == 3 .AND. .NOT. lk_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
     763      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    764764 
    765765      IF( ln_mxl0 ) THEN 

  • trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5329 r5407  
    8282   USE crsini          ! initialise grid coarsening utility 
    8383   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     84   USE sbc_oce, ONLY: lk_oasis 
    8485   USE stopar 
    8586   USE stopts 
    … …  
    197198#if defined key_iomput 
    198199      CALL xios_finalize                ! end mpp communications with xios 
    199       IF( lk_cpl ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
     200      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    200201#else 
    201       IF( lk_cpl ) THEN  
     202      IF( lk_oasis ) THEN  
    202203         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
    203204      ELSE 
    … …  
    228229      ! 
    229230      cltxt = '' 
     231      cxios_context = 'nemo' 
    230232      ! 
    231233      !                             ! Open reference namelist and configuration namelist files 
    … …  
    274276#if defined key_iomput 
    275277      IF( Agrif_Root() ) THEN 
    276          IF( lk_cpl ) THEN 
    277             CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
    278             CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     278         IF( lk_oasis ) THEN 
     279            CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis 
     280            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
    279281         ELSE 
    280             CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     282            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    281283         ENDIF 
    282284      ENDIF 
    283       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
     285      ! Nodes selection (control print return in cltxt) 
     286      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
    284287#else 
    285       IF( lk_cpl ) THEN 
     288      IF( lk_oasis ) THEN 
    286289         IF( Agrif_Root() ) THEN 
    287             CALL cpl_init( ilocal_comm )                       ! nemo local communicator given by oasis 
     290            CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis 
    288291         ENDIF 
    289          narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     292         ! Nodes selection (control print return in cltxt) 
     293         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
    290294      ELSE 
    291295         ilocal_comm = 0 
    292          narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     296         ! Nodes selection (control print return in cltxt) 
     297         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    293298      ENDIF 
    294299#endif 

  • trunk/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5329 r5407  
    8383      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    8484# if defined key_iomput 
    85       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" ) 
     85      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    8686# endif 
    8787#endif 
    8888                             indic = 0           ! reset to no error condition 
    8989      IF( kstp == nit000 ) THEN 
    90                       CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    91          IF( ln_crs ) CALL iom_init( "nemo_crs" )  ! initialize context for coarse grid 
     90         ! must be done after nemo_init for AGRIF+XIOS+OASIS 
     91                      CALL iom_init(      cxios_context          )  ! iom_put initialization 
     92         IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" )  ! initialize context for coarse grid 
    9293      ENDIF 
    9394 
    9495      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    95                              CALL iom_setkt( kstp - nit000 + 1, "nemo"     )   ! say to iom that we are at time step kstp 
    96       IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" )   ! say to iom that we are at time step kstp 
     96                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell iom we are at time step kstp 
     97      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp 
    9798 
    9899      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    168169      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient 
    169170#endif 
    170 #if defined key_traldf_c3d && key_traldf_smag 
     171#if defined key_traldf_c3d && defined key_traldf_smag 
    171172                          CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient 
    172173#  endif 
    173 #if defined key_dynldf_c3d && key_dynldf_smag 
     174#if defined key_dynldf_c3d && defined key_dynldf_smag 
    174175                          CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient 
    175176#  endif 
    … …  
    225226      IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats 
    226227      IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    227       IF( .NOT. lk_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     228      IF( .NOT. ln_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    228229      IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports 
    229230      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag 
    … …  
    355356      ! Coupled mode 
    356357      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    357       IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     358      IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    358359      ! 
    359360#if defined key_iomput 
    360361      IF( kstp == nitend .OR. indic < 0 ) THEN  
    361                       CALL iom_context_finalize( "nemo"     ) ! needed for XIOS+AGRIF 
    362          IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) !  
     362                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
     363         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
    363364      ENDIF 
    364365#endif 

  • trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r5215 r5407  
    131131 
    132132      ! control print 
    133       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
     133      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    134134           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
    135135 

  • trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r5215 r5407  
    4242   USE step_oce        ! module used in the ocean time stepping module 
    4343   USE sbc_oce         ! surface boundary condition: ocean 
    44    USE cla             ! cross land advection               (tra_cla routine) 
    4544   USE domcfg          ! domain configuration               (dom_cfg routine) 
    4645   USE daymod          ! calendar 
    … …  
    5049   USE step            ! NEMO time-stepping                 (stp     routine) 
    5150   USE lib_mpp         ! distributed memory computing 
     51#if defined key_nosignedzero 
     52   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     53#endif 
    5254#if defined key_iomput 
    5355   USE xios 
    5456#endif 
     57   USE cpl_oasis3 
    5558   USE sbcssm 
    56    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
     59   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
     60   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    5761 
    5862   IMPLICIT NONE 
    … …  
    96100      !                            !-----------------------! 
    97101#if defined key_agrif 
    98       CALL Agrif_Declare_Var       ! AGRIF: set the meshes 
     102      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
     103      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     104# if defined key_top 
     105      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
     106# endif 
     107# if defined key_lim2 
     108      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
     109# endif 
    99110#endif 
    100111      ! check that all process are still there... If some process have an error, 
    … …  
    118129         IF( lk_mpp )   CALL mpp_max( nstop ) 
    119130      END DO 
     131      ! 
     132      IF( ln_icebergs )   CALL icb_end( nitend ) 
     133 
    120134      !                            !------------------------! 
    121135      !                            !==  finalize the run  ==! 
    … …  
    136150      ! 
    137151      CALL nemo_closefile 
     152      ! 
    138153#if defined key_iomput 
    139154      CALL xios_finalize                ! end mpp communications with xios 
     155      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    140156#else 
    141       IF( lk_mpp )   CALL mppstop       ! end mpp communications 
     157      IF( lk_oasis ) THEN  
     158         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     159      ELSE 
     160         IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     161      ENDIF 
    142162#endif 
    143163      ! 
    … …  
    154174      INTEGER ::   ilocal_comm   ! local integer       
    155175      INTEGER ::   ios 
    156  
    157176      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    158       !! 
     177      CHARACTER(len=80) ::   clname 
     178      ! 
    159179      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    160180         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    … …  
    163183         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    164184      !!---------------------------------------------------------------------- 
     185      ! 
    165186      cltxt = '' 
    166187      ! 
    167188      !                             ! Open reference namelist and configuration namelist files 
    168       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    169       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     189      IF( lk_oasis ) THEN  
     190         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     191         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     192         cxios_context = 'sas' 
     193         clname = 'output.namelist_sas.dyn' 
     194      ELSE 
     195         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     196         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     197         cxios_context = 'nemo' 
     198         clname = 'output.namelist.dyn' 
     199   ENDIF 
    170200      ! 
    171201      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    … …  
    186216904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    187217 
     218! Force values for AGRIF zoom (cf. agrif_user.F90) 
     219#if defined key_agrif 
     220   IF( .NOT. Agrif_Root() ) THEN 
     221      jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     222      jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     223      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     224      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     225      jpidta  = jpiglo 
     226      jpjdta  = jpjglo 
     227      jpizoom = 1 
     228      jpjzoom = 1 
     229      nperio  = 0 
     230      jperio  = 0 
     231      ln_use_jattr = .false. 
     232   ENDIF 
     233#endif 
     234      ! 
    188235      !                             !--------------------------------------------! 
    189236      !                             !  set communicator & select the local node  ! 
    … …  
    193240#if defined key_iomput 
    194241      IF( Agrif_Root() ) THEN 
    195          CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    196       ENDIF 
    197       narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
     242         IF( lk_oasis ) THEN 
     243            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis  
     244            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     245         ELSE 
     246            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios 
     247         ENDIF 
     248      ENDIF 
     249      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
    198250#else 
    199       ilocal_comm = 0 
    200       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )        ! Nodes selection (control print return in cltxt) 
     251      IF( lk_oasis ) THEN 
     252         IF( Agrif_Root() ) THEN 
     253            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
     254         ENDIF 
     255         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     256      ELSE 
     257         ilocal_comm = 0 
     258         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     259      ENDIF 
    201260#endif 
    202261      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    … …  
    229288      ! than variables 
    230289      IF( Agrif_Root() ) THEN 
     290#if defined key_nemocice_decomp 
     291         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
     292         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     293#else 
    231294         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    232 #if defined key_nemocice_decomp 
    233          jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
    234 #else 
    235295         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    236296#endif 
     297      ENDIF 
    237298         jpk = jpkdta                                             ! third dim 
    238299         jpim1 = jpi-1                                            ! inner domain indices 
    … …  
    240301         jpkm1 = jpk-1                                            !   "           " 
    241302         jpij  = jpi*jpj                                          !  jpi x j 
    242       ENDIF 
    243303 
    244304      IF(lwp) THEN                            ! open listing units 
    245305         ! 
    246          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     306         IF( lk_oasis ) THEN 
     307            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     308         ELSE 
     309            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     310         ENDIF 
    247311         ! 
    248312         WRITE(numout,*) 
    … …  
    287351 
    288352      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    289                             CALL flush(numout) 
    290  
    291353                            CALL day_init   ! model calendar (using both namelist and restart infos) 
    292354 
    … …  
    397459      ENDIF 
    398460      ! 
     461      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
     462         &                                               'f2003 standard. '                              ,  & 
     463         &                                               'Compile with key_nosignedzero enabled' ) 
     464      ! 
    399465   END SUBROUTINE nemo_ctl 
    400466 
    … …  
    438504      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    439505      ! 
    440       INTEGER :: ierr,ierr4 
     506      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 
     507      INTEGER :: jpm 
    441508      !!---------------------------------------------------------------------- 
    442509      ! 
    … …  
    444511      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    445512      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    446          &      snwice_fmass(jpi,jpj), STAT= ierr4 ) 
    447       ierr = ierr + ierr4 
     513         &      snwice_fmass(jpi,jpj), STAT= ierr1 ) 
     514      ! 
     515      ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
     516      ! and ub, vb arrays in ice dynamics 
     517      ! so allocate enough of arrays to use 
     518      ! 
     519      jpm = MAX(jp_tem, jp_sal) 
     520      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 ) 
     521      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 ) 
     522      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 ) 
     523      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
     524      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
     525 
     526      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  
    448527      ! 
    449528      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    … …  
    470549      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    471550      !!---------------------------------------------------------------------- 
    472  
     551      ! 
    473552      ierr = 0 
    474  
     553      ! 
    475554      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    476  
     555      ! 
    477556      IF( nfact <= 1 ) THEN 
    478557         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    … …  
    516595      INTEGER, PARAMETER :: ntest = 14 
    517596      INTEGER :: ilfax(ntest) 
    518  
     597      ! 
    519598      ! lfax contains the set of allowed factors. 
    520599      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    … …  
    601680          !loop over the other north-fold processes to find the processes 
    602681          !managing the points belonging to the sxT-dxT range 
    603           DO jn = jpnij - jpni +1, jpnij 
    604              IF ( njmppt(jn) == njmppmax ) THEN 
     682   
     683          DO jn = 1, jpni 
    605684                !sxT is the first point (in the global domain) of the jn 
    606685                !process 
    607                 sxT = nimppt(jn) 
     686                sxT = nfiimpp(jn, jpnj) 
    608687                !dxT is the last point (in the global domain) of the jn 
    609688                !process 
    610                 dxT = nimppt(jn) + nlcit(jn) - 1 
     689                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    611690                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    612691                   nsndto = nsndto + 1 
    613                    isendto(nsndto) = jn 
    614                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     692                     isendto(nsndto) = jn 
     693                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    615694                   nsndto = nsndto + 1 
    616695                   isendto(nsndto) = jn 
    … …  
    619698                   isendto(nsndto) = jn 
    620699                END IF 
    621              END IF 
    622700          END DO 
     701          nfsloop = 1 
     702          nfeloop = nlci 
     703          DO jn = 2,jpni-1 
     704           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     705              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     706                 nfsloop = nldi 
     707              ENDIF 
     708              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     709                 nfeloop = nlei 
     710              ENDIF 
     711           ENDIF 
     712        END DO 
     713 
    623714      ENDIF 
    624715      l_north_nogather = .TRUE. 

  • trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r5215 r5407  
    3636   PUBLIC   sbc_ssm        ! called by sbc 
    3737 
    38    CHARACTER(len=100)   ::   cn_dir     = './'    !: Root directory for location of ssm files 
    39    LOGICAL              ::   ln_3d_uv   = .true.  !: specify whether input velocity data is 3D 
    40    INTEGER  , SAVE      ::   nfld_3d 
    41    INTEGER  , SAVE      ::   nfld_2d 
    42  
    43    INTEGER  , PARAMETER ::   jpfld_3d = 4   ! maximum number of files to read 
    44    INTEGER  , PARAMETER ::   jpfld_2d = 1   ! maximum number of files to read 
    45    INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    46    INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
    47    INTEGER  , SAVE      ::   jf_usp         ! index of u velocity component 
    48    INTEGER  , SAVE      ::   jf_vsp         ! index of v velocity component 
    49    INTEGER  , SAVE      ::   jf_ssh         ! index of sea surface height 
     38   CHARACTER(len=100)   ::   cn_dir        !: Root directory for location of ssm files 
     39   LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D 
     40   LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not 
     41   LOGICAL              ::   l_initdone = .false. 
     42   INTEGER     ::   nfld_3d 
     43   INTEGER     ::   nfld_2d 
     44 
     45   INTEGER     ::   jf_tem         ! index of temperature 
     46   INTEGER     ::   jf_sal         ! index of salinity 
     47   INTEGER     ::   jf_usp         ! index of u velocity component 
     48   INTEGER     ::   jf_vsp         ! index of v velocity component 
     49   INTEGER     ::   jf_ssh         ! index of sea surface height 
     50   INTEGER     ::   jf_e3t         ! index of first T level thickness 
     51   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level 
    5052 
    5153   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read) 
    5254   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read) 
    5355 
    54    !! * Substitutions 
    55 #  include "domzgr_substitute.h90" 
    56 #  include "vectopt_loop_substitute.h90" 
    5756   !!---------------------------------------------------------------------- 
    5857   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    … …  
    8685      IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    8786      !  
    88       IF( ln_3d_uv ) THEN 
     87      IF( ln_3d_uve ) THEN 
    8988         ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    9089         ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     90         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
    9191      ELSE 
    9292         ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    9393         ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     94         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
    9495      ENDIF 
    9596      ! 
    … …  
    9798      sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity 
    9899      ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
    99       ! 
    100       tsn(:,:,1,jp_tem) = sst_m(:,:) 
    101       tsn(:,:,1,jp_sal) = sss_m(:,:) 
     100      IF( ln_read_frq )   frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
     101      ! 
    102102      IF ( nn_ice == 1 ) THEN 
     103         tsn(:,:,1,jp_tem) = sst_m(:,:) 
     104         tsn(:,:,1,jp_sal) = sss_m(:,:) 
    103105         tsb(:,:,1,jp_tem) = sst_m(:,:) 
    104106         tsb(:,:,1,jp_sal) = sss_m(:,:) 
    105107      ENDIF 
    106       ub (:,:,1       ) = ssu_m(:,:) 
    107       vb (:,:,1       ) = ssv_m(:,:) 
     108      ub (:,:,1) = ssu_m(:,:) 
     109      vb (:,:,1) = ssv_m(:,:) 
    108110 
    109111      IF(ln_ctl) THEN                  ! print control 
    … …  
    113115         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   ) 
    114116         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   ) 
     117         IF( lk_vvl      )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   ) 
     118         IF( ln_read_frq )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   ) 
     119      ENDIF 
     120      ! 
     121      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   ! 
     122         CALL iom_put( 'ssu_m', ssu_m ) 
     123         CALL iom_put( 'ssv_m', ssv_m ) 
     124         CALL iom_put( 'sst_m', sst_m ) 
     125         CALL iom_put( 'sss_m', sss_m ) 
     126         CALL iom_put( 'ssh_m', ssh_m ) 
     127         IF( lk_vvl      )   CALL iom_put( 'e3t_m', e3t_m ) 
     128         IF( ln_read_frq )   CALL iom_put( 'frq_m', frq_m ) 
    115129      ENDIF 
    116130      ! 
    … …  
    138152      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read 
    139153      TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read 
    140       TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 
    141       ! 
    142       NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 
    143       !!---------------------------------------------------------------------- 
     154      TYPE(FLD_N) :: sn_usp, sn_vsp 
     155      TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 
     156      ! 
     157      NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
     158      !!---------------------------------------------------------------------- 
     159       
     160      IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 
    144161       
    145162      REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields 
    … …  
    159176         WRITE(numout,*) '~~~~~~~~~~~ ' 
    160177         WRITE(numout,*) '   Namelist namsbc_sas' 
     178         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
     179         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
    161180         WRITE(numout,*) 
    162181      ENDIF 
    163        
    164182      ! 
    165183      !! switch off stuff that isn't sensible with a standalone module 
    … …  
    170188         ln_apr_dyn = .FALSE. 
    171189      ENDIF 
    172       IF( ln_dm2dc ) THEN 
    173          IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme' 
    174          ln_dm2dc = .FALSE. 
    175       ENDIF 
    176190      IF( ln_rnf ) THEN 
    177191         IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' 
    … …  
    190204         nn_closea = 0 
    191205      ENDIF 
    192  
    193206      !  
    194207      !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    195208      !! when we have other 3d arrays that we need to read in 
    196209      !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 
    197       !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d, 
    198       !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 
     210      !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 
     211      !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 
    199212      !! and the rest of the logic should still work 
    200213      ! 
    201       jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 
    202       ! 
    203       IF( ln_3d_uv ) THEN 
    204          jf_usp = 1 ; jf_vsp = 2 
    205          nfld_3d  = 2 
    206          nfld_2d  = 3 
     214      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4   ! default 2D fields index 
     215      ! 
     216      IF( ln_3d_uve ) THEN 
     217         jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index 
     218         nfld_3d  = 2 + COUNT( (/lk_vvl/) )        ! number of 3D fields to read 
     219         nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read 
    207220      ELSE 
    208          jf_usp = 4 ; jf_vsp = 5 
    209          nfld_3d  = 0 
    210          nfld_2d  = 5 
     221         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) )   ! update 2D fields index 
     222         nfld_3d  = 0                                                              ! no 3D fields to read 
     223         nfld_2d  = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read 
    211224      ENDIF 
    212225 
    … …  
    216229            CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN 
    217230         ENDIF 
    218          IF( ln_3d_uv ) THEN 
    219             slf_3d(jf_usp) = sn_usp 
    220             slf_3d(jf_vsp) = sn_vsp 
    221          ENDIF 
     231         slf_3d(jf_usp) = sn_usp 
     232         slf_3d(jf_vsp) = sn_vsp 
     233         IF( lk_vvl )   slf_3d(jf_e3t) = sn_e3t 
    222234      ENDIF 
    223235 
    … …  
    228240         ENDIF 
    229241         slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 
    230          IF( .NOT. ln_3d_uv ) THEN 
     242         IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq 
     243         IF( .NOT. ln_3d_uve ) THEN 
    231244            slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 
    232          ENDIF 
    233       ENDIF 
    234       ! 
     245            IF( lk_vvl )   slf_2d(jf_e3t) = sn_e3t 
     246         ENDIF 
     247      ENDIF 
     248      ! 
     249      ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
    235250      IF( nfld_3d > 0 ) THEN 
    236251         ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
    … …  
    265280      ENDIF 
    266281      ! 
    267       ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
    268       ! and ub, vb arrays in ice dynamics 
    269       ! so allocate enough of arrays to use 
    270       ! 
    271       ierr3 = 0 
    272       jpm = MAX(jp_tem, jp_sal) 
    273       ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 ) 
    274       ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 ) 
    275       ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 ) 
    276       IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 ) 
    277       ierr = ierr0 + ierr1 + ierr2 + ierr3 
    278       IF( ierr > 0 ) THEN 
    279          CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays') 
    280       ENDIF 
    281       ! 
    282282      ! finally tidy up 
    283283 
    284284      IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 
    285285      IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 
     286 
     287      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate 
     288      IF( .NOT. ln_read_frq )   frq_m(:,:) = 1. 
     289      l_initdone = .TRUE. 
    286290      ! 
    287291   END SUBROUTINE sbc_ssm_init 

  • trunk/NEMOGCM/NEMO/SAS_SRC/step.F90

    r5215 r5407  
    1717   USE dom_oce          ! ocean space and time domain variables  
    1818   USE in_out_manager   ! I/O manager 
     19   USE sbc_oce 
     20   USE sbccpl 
    1921   USE iom              ! 
    2022   USE lbclnk 
    … …  
    7274      kstp = nit000 + Agrif_Nb_Step() 
    7375# if defined key_iomput 
    74       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" ) 
     76      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    7577# endif    
    7678#endif    
    77       IF( kstp == nit000 )   CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     79      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    7880      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
    79                              CALL iom_setkt( kstp, "nemo" )       ! say to iom that we are at time step kstp 
     81                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp 
    8082 
    8183                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    … …  
    8688                                                          ! need to keep the same interface  
    8789                             CALL stp_ctl( kstp, indic ) 
     90      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     91      ! Coupled mode 
     92      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     93      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice 
     94 
    8895#if defined key_iomput 
    89       IF( kstp == nitend )   CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     96      IF( kstp == nitend .OR. indic < 0 ) THEN  
     97                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
     98      ENDIF 
    9099#endif 
    91100      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90

    r4996 r5407  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_c14b && defined key_iomput 
     8#if defined key_top && defined key_c14b && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_c14b'                                           c14b model 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90

    r4996 r5407  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_cfc && defined key_iomput 
     8#if defined key_top && defined key_cfc && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_cfc'                                           cfc model 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r4996 r5407  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_my_trc && defined key_iomput 
     8#if defined key_top && defined key_my_trc && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_my_trc'                                           my_trc model 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5385 r5407  
    7272      CALL top_alloc()              ! allocate TOP arrays 
    7373 
    74       l_trcdm2dc = ln_dm2dc .OR. ( lk_cpl .AND. ncpl_qsr_freq /= 1 ) 
     74      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    7575      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline 
    7676      IF( l_trcdm2dc .AND. lwp ) & 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5385 r5407  
    132132 
    133133      IF( kt == nittrc000 ) THEN 
    134          IF( lk_cpl )  THEN   
     134         IF( ln_cpl )  THEN   
    135135            rdt_sampl = 86400. / ncpl_qsr_freq 
    136136            nb_rec_per_days = ncpl_qsr_freq 

  • trunk/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE

    r4147 r5407  
    88#MSUB -n NPROCS              # Total number of mpi task to use 
    99####  #MSUB -N 2                   # number of nodes to use 
    10 #MSUB -A gen0826             # project name 
     10#MSUB -ra2286             # project name 
    1111#MSUB -q standard            # (queue name) only for thin nodes 
    1212########################################################################## 
    … …  
    3333module unload netcdf 
    3434module unload hdf5 
    35 module load netcdf/4.2_hdf5_parallel 
    36 module load hdf5/1.8.9_parallel 
     35module load netcdf/4.3.3.1_hdf5_parallel 
     36module load hdf5/1.8.12_parallel 
    3737 
    3838# Don't remove neither change the following line 

  • trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh

    r5302 r5407  
    3232   # same story but for wrk_dealloc 
    3333   nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 
    34    [ $(( 2 * $nn1 )) -ne $nn2 ] && echo "problem with wrk_dealloc in $ff"  
     34   if [ $(( 2 * $nn1 )) -ne $nn2 ] 
     35   then 
     36       echo "problem with wrk_dealloc in $ff" 
     37       grep -i "call *wrk_alloc *(" $ff 
     38       grep -i "call *wrk_dealloc *(" $ff 
     39       echo 
     40   fi 
    3541    fi 
    3642     

  • trunk/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh

    r3294 r5407  
    11#!/bin/bash 
     2# 
     3# rsync -av NEMO/ NEMO_no_wrkarrays/ 
     4# cd NEMO_no_wrkarrays/ 
     5# ../TOOLS/MISCELLANEOUS/rewrite_nemo.sh 
     6# cd ../CONFIG 
     7# ./makenemo -n ORCA2_LIM3 -s NEMO_no_wrkarrays 
    28# 
    39set -u 
    410#set -xv 
    511# 
    6 # for on each file containing a call to work alloc (exept BDY files that are too complicated...) 
    7 #for i in $( ack -il "^ *call *wrk_alloc *\(" | grep -v BDY ) 
    8 for i in $( egrep -iRl "^ *call *wrk_alloc *\(" * | grep "90$" | grep -v BDY ) 
     12# for on each file containing a call to work alloc 
     13for i in $( grep -iRl "^[^\!]*call *wrk_alloc *(" * | grep "90$" ) 
    914do 
    1015# create a temporary file that will be easier to process... 
    … …  
    2833# 
    2934# number of the lines containing wrk_alloc 
    30     cnt=$( grep -ci "^ *call *wrk_alloc *(" tmp$$ ) 
     35    cnt=$( grep -ci "^[^\!]*call *wrk_alloc *(" tmp$$ ) 
    3136# for each of these lines 
    3237    ll=1 
    … …  
    3439    do 
    3540# get the line with its number 
    36    line=$( grep -in "^ *call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" ) 
     41   line=$( grep -in "^[^\!]*call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" ) 
    3742# get its number 
    3843   lline=$( echo $line | sed -e "s/:.*//" ) 
    3944# keep only the arument of wrk_alloc between () 
    40    line=$( echo $line | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" ) 
     45   line=$( echo $line | sed -e "s/^.*[cC][aA][lL][lL] *[wW][rR][kK]_[aA][lL][lL][oO][cC]//" | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" ) 
    4146# find in which subroutine or function is located this call to wrk_alloc: l1 beginning l2: end 
    4247   for lll in $linesbegin 
    … …  
    132137# 
    133138# OPA_SRC/SBC/albedo.F90 
    134 sed -e "s/DIMENSION(jpi,jpj,ijpl)/DIMENSION(jpi,jpj,SIZE(pt_ice,3))/" OPA_SRC/SBC/albedo.F90 > tmp$$ 
     139sed -e "s/DIMENSION(jpi,jpj,ijpl/DIMENSION(jpi,jpj,SIZE(pt_ice,3)/" OPA_SRC/SBC/albedo.F90 > tmp$$ 
    135140mv tmp$$ OPA_SRC/SBC/albedo.F90 
     141# see result of 
     142#    grep -i "wrk_alloc" $( find . -name "*90" ) | grep "=" 
     143# 
    136144# LIM_SRC_2/limrhg_2.F90 
    137 sed -e "s/DIMENSION(jpi,jpj+2)/DIMENSION(jpi,0:jpj+1)/" LIM_SRC_2/limrhg_2.F90 > tmp$$ 
     145#./LIM_SRC_2/limrhg_2.F90:      CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 
     146#./LIM_SRC_2/limrhg_2.F90:      CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) 
     147sed -e "s/DIMENSION(jpi,jpj+2/DIMENSION(jpi,0:jpj+1/" LIM_SRC_2/limrhg_2.F90 > tmp$$ 
    138148mv tmp$$ LIM_SRC_2/limrhg_2.F90 
     149 
    139150# LIM_SRC_3/limitd_me.F90 
     151#./LIM_SRC_3/limitd_me.F90:      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    140152sed -e "s/DIMENSION(jpi,jpj,jpl+2)/DIMENSION(jpi,jpj,-1:jpl)/" LIM_SRC_3/limitd_me.F90 > tmp$$ 
    141153mv tmp$$ LIM_SRC_3/limitd_me.F90 
     154 
    142155# LIM_SRC_3/limitd_th.F90 
     156#./LIM_SRC_3/limitd_th.F90:      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    143157sed -e "s/DIMENSION(jpi,jpj,jpl+1)/DIMENSION(jpi,jpj,0:jpl)/" LIM_SRC_3/limitd_th.F90 > tmp$$ 
    144158mv tmp$$ LIM_SRC_3/limitd_th.F90 
     159 
    145160# LIM_SRC_3/limthd_dif.F90 
     161#./LIM_SRC_3/limthd_dif.F90:      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 
     162#./LIM_SRC_3/limthd_dif.F90:      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 
    146163sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \ 
    147164    -e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$ 
    148165mv tmp$$ LIM_SRC_3/limthd_dif.F90 
     166 
    149167# LIM_SRC_3/limthd_ent.F90 
    150 sed -e "s/DIMENSION(jpij,jkmax+4)/DIMENSION(jpij,0:jkmax+3)/" \ 
    151     -e "s/DIMENSION(jkmax+4,jkmax+4)/DIMENSION(0:jkmax+3,0:jkmax+3)/" LIM_SRC_3/limthd_ent.F90 > tmp$$ 
     168#./LIM_SRC_3/limthd_ent.F90:      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 
     169#./LIM_SRC_3/limthd_ent.F90:      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 
     170sed -e "s/DIMENSION(jpij,nlay_i+3)/DIMENSION(jpij,0:nlay_i+2)/" \ 
     171    -e "s/DIMENSION(jpij,nlay_i+1)/DIMENSION(jpij,0:nlay_i)/" LIM_SRC_3/limthd_ent.F90 > tmp$$ 
    152172mv tmp$$ LIM_SRC_3/limthd_ent.F90 
     173 
    153174# OPA_SRC/DYN/divcur.F90 
     175#./OPA_SRC/DYN/divcur.F90:      CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
    154176sed -e "s/DIMENSION(jpi+4,jpj)/DIMENSION(-1:jpi+2,jpj)/" OPA_SRC/DYN/divcur.F90 > tmp$$ 
    155177mv tmp$$ OPA_SRC/DYN/divcur.F90 
     178 
    156179# OPA_SRC/LDF/ldfslp.F90 
     180#./OPA_SRC/LDF/ldfslp.F90:      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
     181#./OPA_SRC/LDF/ldfslp.F90:      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    157182sed -e "s/DIMENSION(jpi,jpj,jpk,2)/DIMENSION(jpi,jpj,jpk,0:1)/" \ 
    158183    -e "s/DIMENSION(jpi,jpj,2,2)/DIMENSION(jpi,jpj,0:1,0:1)/" OPA_SRC/LDF/ldfslp.F90 > tmp$$ 
    159184mv tmp$$ OPA_SRC/LDF/ldfslp.F90 
    160185# OPA_SRC/ZDF/zdfkpp.F90 
     186#./OPA_SRC/ZDF/zdfkpp.F90:      CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 ) 
    161187sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) ::   zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$ 
    162188mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90 
    163189 
    164 # link for limrhg.F90... 
     190# links  
     191# see result of 
     192# find . -type l 
     193# 
     194# ./LIM_SRC_2/limrhg.F90 
    165195cd LIM_SRC_2 
    166196ln -sf ../LIM_SRC_3/limrhg.F90 . 
     197cd .. 
     198 
     199# ./OOO_SRC/dtadyn.F90 
     200cd OOO_SRC 
     201ln -sf ../OFF_SRC/dtadyn.F90 . 
     202cd .. 
     203 
     204# ./OOO_SRC/obs_fbm.F90 
     205cd OOO_SRC 
     206ln -sf ../OPA_SRC/OBS/obs_fbm.F90 . 
     207cd .. 
Note: See TracChangeset for help on using the changeset viewer.