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 4901 – NEMO

Changeset 4901


Ignore:
Timestamp:
2014-11-27T16:41:22+01:00 (9 years ago)
Author:
cetlod
Message:

2014/dev_CNRS_2014 : merge the 3rd branch onto dev_CNRS_2014, see ticket #1415

Location:
branches/2014/dev_CNRS_2014/NEMOGCM
Files:
2 deleted
41 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r4900 r4901  
    326326     <variable id="buffer_server_factor_size" type="integer">2</variable> 
    327327     <variable id="info_level"                type="integer">0</variable> 
    328      <variable id="using_server"              type="boolean">true</variable> 
     328     <variable id="using_server"              type="boolean">false</variable> 
    329329     <variable id="using_oasis"               type="boolean">false</variable> 
    330330     <variable id="oasis_codes_id"            type="string" >oceanx</variable> 
  • branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/field_def.xml

    r4896 r4901  
    210210         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 unit="m"        /> 
    211211         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                unit="m/s"      /> 
     212         <field id="iiceconc"     long_name="Ice concentration"                                            unit=""         /> 
    212213          
    213214         <field id="ice_pres"     long_name="Ice presence"                                                 unit="-"        /> 
  • branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4900 r4901  
    231231   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    232232   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    233    ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    234233   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    235234   nn_ice      = 2         !  =0 no ice boundary condition   , 
    236235                           !  =1 use observed ice-cover      , 
    237                            !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     236                           !  =2 ice-model used                         ("key_lim3" or "key_lim2") 
    238237   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    239238                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     
    251250   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
    252251                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    253    cn_iceflx = 'linear'    !  redistribution of solar input into ice categories during coupling ice/atm. 
     252   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used) 
     253                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled 
     254                           !  = 0  Average per-category fluxes (forced and coupled mode) 
     255                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled 
     256                           !  = 2  Redistribute a single flux over categories (coupled mode only) 
    254257/ 
    255258!----------------------------------------------------------------------- 
     
    336339!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
    337340! send 
    338 sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
    339 sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
    340 sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
    341 sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
    342 sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
     341   sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     342   sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     343   sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
     344   sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     345   sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    343346! receive 
    344 sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    345 sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    346 sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
    347 sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    348 sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    349 sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    350 sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
    351 sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    352 sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    353 sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     347   sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     348   sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     349   sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     350   sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     351   sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     352   sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     353   sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     354   sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     355   sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     356   sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     357! 
     358   nn_cplmodel   =     1     !  Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     359   ln_usecplmask = .false.   !  use a coupling mask file to merge data received from several models 
     360                             !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    354361/ 
    355362!----------------------------------------------------------------------- 
  • branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/cfg.txt

    r4900 r4901  
    11GYRE_PISCES OPA_SRC TOP_SRC 
    22ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    3 GYRE OPA_SRC 
    43GYRE_XIOS OPA_SRC 
    54ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     
    109GYRE_BFM OPA_SRC TOP_SRC 
    1110ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     11GYRE OPA_SRC 
    1212ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r4306 r4901  
    3030   USE sbc_oce          ! surface boundary condition: ocean 
    3131   USE sbccpl 
    32    USE cpl_oasis3, ONLY : lk_cpl 
    3332   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    3433   USE albedo           ! albedo parameters 
     
    9796      !!              - emp     : freshwater budget: mass flux  
    9897      !!              - sfx     : freshwater budget: salt flux due to Freezing/Melting 
    99       !!              - utau    : sea surface i-stress (ocean referential) 
    100       !!              - vtau    : sea surface j-stress (ocean referential) 
    10198      !!              - fr_i    : ice fraction 
    10299      !!              - tn_ice  : sea-ice surface temperature 
    103       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     100      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    104101      !! 
    105102      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    183180 
    184181            !   computation the solar flux at ocean surface 
    185 #if defined key_coupled  
    186             zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    187 #else 
    188             zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    189 #endif             
     182            IF( lk_cpl ) THEN 
     183               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
     184            ELSE 
     185               zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
     186            ENDIF 
    190187            !  computation the non solar heat flux at ocean surface 
    191188            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads 
     
    206203            ! 
    207204            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
    208 #if defined key_coupled 
    209205            !                                                  ! coupled mode:  
    210             zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
    211                &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
    212 #else 
    213             !                                                  ! forced  mode:  
    214             zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
    215                &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
    216                &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
    217 #endif             
     206            IF( lk_cpl ) THEN 
     207               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
     208                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     209            ELSE 
     210               !                                                  ! forced  mode:  
     211               zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
     212                  &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
     213                  &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
     214            ENDIF 
    218215            ! 
    219216            ! mass flux at the ocean/ice interface (sea ice fraction) 
     
    259256      !-----------------------------------------------! 
    260257 
    261 #if defined key_coupled 
    262       tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    263       ht_i(:,:,1) = hicif(:,:) 
    264       ht_s(:,:,1) = hsnif(:,:) 
    265       a_i(:,:,1) = fr_i(:,:) 
    266       !                                  ! Computation of snow/ice and ocean albedo 
    267       CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
    268       alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
    269       CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
    270 #endif 
     258      IF( lk_cpl) THEN 
     259         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
     260         ht_i(:,:,1) = hicif(:,:) 
     261         ht_s(:,:,1) = hsnif(:,:) 
     262         a_i(:,:,1) = fr_i(:,:) 
     263         !                                  ! Computation of snow/ice and ocean albedo 
     264         CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
     265         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     266         CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
     267      ENDIF 
    271268 
    272269      IF(ln_ctl) THEN            ! control print 
    273270         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ') 
    274271         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx   , clinfo2=' sfx     : ') 
    275          CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    276             &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask ) 
    277272         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    278273      ENDIF  
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r4900 r4901  
    3333   USE limtab_2 
    3434   USE prtctl           ! Print control 
    35    USE cpl_oasis3, ONLY :   lk_cpl 
    3635   USE diaar5    , ONLY :   lk_diaar5 
    3736   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     
    219218                         
    220219            !  partial computation of the lead energy budget (qldif) 
    221 #if defined key_coupled  
    222             qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
    223                &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
    224                &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
    225                &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
    226 #else 
    227             qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
    228                &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
    229                &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
    230                &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
    231 #endif 
     220            IF( lk_cpl ) THEN  
     221               qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
     222                  &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
     223                  &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
     224                  &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
     225            ELSE 
     226               qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
     227                  &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
     228                  &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
     229                  &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
     230            ENDIF 
    232231            !  parlat : percentage of energy used for lateral ablation (0.0)  
    233232            zfntlat        = 1.0 - MAX( rzero , SIGN( rone ,  - qldif(ji,jj) ) ) 
     
    449448      zztmp = 1.0 / rdt_ice 
    450449      CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced               [m/s] 
     450      CALL iom_put( 'iiceconc'    , fr_i(:,:)                )   ! Ice concentration          [-] 
    451451      IF( lk_diaar5 ) THEN 
    452452         CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s] 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r4306 r4901  
    1818   USE ice_2 
    1919   USE limistate_2 
    20    USE cpl_oasis3, ONLY : lk_cpl 
     20   USE sbc_oce, ONLY : lk_cpl 
    2121   USE in_out_manager 
    2222   USE lib_mpp          ! MPP library 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r4897 r4901  
    8989      CALL lim_itd_ini                 ! ice thickness distribution initialization 
    9090      ! 
     91      CALL lim_itd_me_init             ! ice thickness distribution initialization 
    9192      !                                ! Initial sea-ice state 
    9293      IF( .NOT. ln_rstart ) THEN              ! start from rest 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4900 r4901  
    2929   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3030   USE wrk_nemo         ! work arrays 
    31    USE cpl_oasis3, ONLY : lk_cpl 
    3231 
    3332   IMPLICIT NONE 
     
    113112 
    114113      CALL lim_istate_init     !  reading the initials parameters of the ice 
    115  
    116 # if defined key_coupled 
    117       albege(:,:)   = 0.8 * tms(:,:) 
    118 # endif 
    119114 
    120115      ! surface temperature 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4900 r4901  
    150150      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    151151 
    152       IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
    153  
    154152      IF(ln_ctl) THEN 
    155153         CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i  : ', tab2d_2=at_i   , clinfo2=' at_i    : ') 
     
    10371035            !     / rafting category n1. 
    10381036            !-------------------------------------------------------------------------- 
    1039             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
     1037            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 
    10401038            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 
    10411039            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
     
    10431041            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    10441042            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1045             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
     1043            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
    10461044            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
    10471045 
     
    11281126               jj = indxj(ij) 
    11291127               ! heat content of ridged ice 
    1130                erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )  
     1128               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj)  
    11311129               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    11321130               e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4900 r4901  
    3232   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3333   USE sbccpl 
    34    USE cpl_oasis3, ONLY : lk_cpl 
    35    USE oce       , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     34   USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3635   USE albedo           ! albedo parameters 
    3736   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
     
    9897      !!              - fr_i    : ice fraction 
    9998      !!              - tn_ice  : sea-ice surface temperature 
    100       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     99      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    101100      !! 
    102101      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    103102      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
     103      !!              These refs are now obsolete since everything has been revised 
     104      !!              The ref should be Rousset et al., 2015? 
    104105      !!--------------------------------------------------------------------- 
    105       INTEGER, INTENT(in) ::   kt    ! number of iteration 
    106       ! 
    107       INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices 
    108       REAL(wp) ::   zinda, zemp      ! local scalars 
    109       REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    110       REAL(wp) ::   zfcm1           ! New solar flux received by the ocean 
    111       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
     106      INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
     107      ! 
     108      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
     109      ! 
     110      REAL(wp) ::   zinda, zemp                                     !  local scalars 
     111      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     112      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     113      ! 
     114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
    112115      !!--------------------------------------------------------------------- 
    113        
    114       IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    115116 
    116117      ! make calls for heat fluxes before it is modified 
     
    134135            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
    135136            !--------------------------------------------------- 
    136             IF( lk_cpl ) THEN ! be carfeful: not been tested yet 
    137                ! original line 
     137            IF( lk_cpl ) THEN  
     138               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    138139               zfcm1 = qsr_tot(ji,jj) 
    139                !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
    140140               DO jl = 1, jpl 
    141                   zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 
     141                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 
    142142               END DO 
    143143            ELSE 
    144                !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
    145                !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
     144               !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    146145               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
    147146               DO jl = 1, jpl 
     
    215214 
    216215      !------------------------------------------------! 
    217       !    Computation of snow/ice and ocean albedo    ! 
     216      !    Snow/ice albedo (only if sent to coupler)   ! 
    218217      !------------------------------------------------! 
    219218      IF( lk_cpl ) THEN          ! coupled case 
    220          CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    221          alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
     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 
    222228      ENDIF 
    223229 
     
    229235         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    230236      ENDIF 
    231       ! 
    232       IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 
    233       !  
     237 
    234238   END SUBROUTINE lim_sbc_flx 
    235239 
     
    344348      ! clem modif 
    345349      IF( .NOT. ln_rstart ) THEN 
    346          iatte(:,:) = 1._wp 
    347          oatte(:,:) = 1._wp 
     350         fraqsr_1lev(:,:) = 1._wp 
    348351      ENDIF 
    349352      ! 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4900 r4901  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY :  iatte, oatte 
     24   USE oce     , ONLY : fraqsr_1lev 
    2525   USE ice            ! LIM: sea-ice variables 
    2626   USE par_ice        ! LIM: sea-ice parameters 
     
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
    45    USE cpl_oasis3, ONLY : lk_cpl 
    4645   USE limcons        ! conservation tests 
    4746 
     
    6867      !!                ***  ROUTINE lim_thd  ***        
    6968      !!   
    70       !! ** Purpose : This routine manages the ice thermodynamic. 
     69      !! ** Purpose : This routine manages ice thermodynamics 
    7170      !!          
    7271      !! ** Action : - Initialisation of some variables 
     
    7473      !!               at the ice base, snow acc.,heat budget of the leads) 
    7574      !!             - selection of the icy points and put them in an array 
    76       !!             - call lim_vert_ther for vert ice thermodynamic 
    77       !!             - back to the geographic grid 
    78       !!             - selection of points for lateral accretion 
    79       !!             - call lim_lat_acc  for the ice accretion 
     75      !!             - call lim_thd_dif  for vertical heat diffusion 
     76      !!             - call lim_thd_dh   for vertical ice growth and melt 
     77      !!             - call lim_thd_ent  for enthalpy remapping 
     78      !!             - call lim_thd_sal  for ice desalination 
     79      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy 
    8080      !!             - back to the geographic grid 
    8181      !!      
    82       !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
     82      !! ** References :  
    8383      !!--------------------------------------------------------------------- 
    8484      INTEGER, INTENT(in) ::   kt    ! number of iteration 
     
    9393      ! 
    9494      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     95      ! 
     96      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9597      !!------------------------------------------------------------------- 
     98      CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 
     99 
    96100      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    97101 
     
    137141      !-----------------------------------------------------------------------------! 
    138142 
     143      !--- Ocean solar and non solar fluxes to be used in zqld 
     144      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
     145         ! 
     146         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
     147         ! 
     148      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
     149         ! 
     150         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
     151         ! 
     152         DO jl = 1, jpl 
     153            DO jj = 1, jpj 
     154               DO ji = 1, jpi 
     155                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 
     156                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 
     157               END DO 
     158            END DO 
     159         END DO 
     160         ! 
     161      ENDIF 
     162 
    139163!CDIR NOVERRCHK 
    140164      DO jj = 1, jpj 
     
    149173            !           !  temperature and turbulent mixing (McPhee, 1992) 
    150174            ! 
     175 
    151176            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
    152             zqld =  tms(ji,jj) * rdt_ice *                                       & 
    153                &  ( pfrld(ji,jj)         * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif 
    154                &                           + qns(ji,jj) )                        &   ! non solar heat 
    155                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    156                &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     177            zqld =  tms(ji,jj) * rdt_ice *                                          & 
     178               &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 
     179               &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) *     & ! heat content of precip 
     180               &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
    157181               &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     182               ! REMARK valid at least in forced mode from clem 
     183               ! precip is included in qns but not in qns_ice 
    158184 
    159185            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     
    185211            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
    186212               ! heat flux above the ocean 
    187                &    +             pfrld(ji,jj)   * ( qns(ji,jj) + qsr(ji,jj) )                                                    & 
     213               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
    188214               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    189215               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     
    306332            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    307333            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    308  
    309             CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) )  
    310             CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) )  
    311334 
    312335            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     
    482505      ENDIF 
    483506      ! 
     507      ! 
     508      CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
     509 
     510      ! 
    484511      ! conservation test 
    485512      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    486513      ! 
    487514      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     515 
    488516   END SUBROUTINE lim_thd  
    489517 
     
    552580902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 
    553581      IF(lwm) WRITE ( numoni, namicethd ) 
     582 
     583      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
    554584      ! 
    555585      IF(lwp) THEN                          ! control print 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4900 r4901  
    2626   USE wrk_nemo       ! work arrays 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    28    USE cpl_oasis3, ONLY : lk_cpl 
    2928    
    3029   IMPLICIT NONE 
     
    166165      ! 
    167166      DO ji = kideb, kiut 
    168          zinda         = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 
    169          ztmelts       = zinda * rtt + ( 1._wp - zinda ) * rtt 
    170  
    171          zfdum     = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    172          zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
     167         zinda      = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 
     168         ztmelts    = zinda * rtt + ( 1._wp - zinda ) * rtt 
     169 
     170         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     171         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    173172 
    174173         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4900 r4901  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    27    USE cpl_oasis3, ONLY : lk_cpl 
     27   USE sbc_oce, ONLY : lk_cpl 
    2828 
    2929   IMPLICIT NONE 
     
    146146      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid   ! tridiagonal system terms 
    147147      ! diag errors on heat 
    148       REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 
    149       REAL(wp)                        :: zhfx_err 
     148      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 
    150149      !!------------------------------------------------------------------      
    151150      !  
     
    158157      CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 
    159158 
    160       CALL wrk_alloc( jpij, zdq, zq_ini ) 
     159      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
    161160 
    162161      ! --- diag error on heat diffusion - PART 1 --- ! 
     
    272271 
    273272      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    274          !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    275273         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    276274      END DO 
     
    407405         !------------------------------------------------------------------------------| 
    408406         ! 
    409          DO ji = kideb , kiut 
    410             ! update of the non solar flux according to the update in T_su 
    411             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 
    412  
     407         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case 
     408            DO ji = kideb , kiut 
     409               ! update of the non solar flux according to the update in T_su 
     410               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 
     411            END DO 
     412         ENDIF 
     413 
     414         ! Update incoming flux 
     415         DO ji = kideb , kiut 
    413416            ! update incoming flux 
    414417            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    415                + qns_ice_1d(ji)                  ! non solar total flux  
     418               + qns_ice_1d(ji)                   ! non solar total flux  
    416419            ! (LWup, LWdw, SH, LH) 
    417420         END DO 
     
    737740      CALL lim_thd_enmelt( kideb, kiut ) 
    738741 
    739       ! --- diag error on heat diffusion - PART 2 --- ! 
     742      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    740743      DO ji = kideb, kiut 
    741744         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
    742745            &                              SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
    743          zhfx_err    = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
    744          hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 
    745          ! --- correction of qns_ice and surface conduction flux --- ! 
    746          qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err  
    747          fc_su     (ji) = fc_su     (ji) - zhfx_err  
    748          ! --- Heat flux at the ice surface in W.m-2 --- ! 
     746         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     747         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_b(ji) 
     748      END DO  
     749 
     750      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 
     751      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed 
     752         ! 
     753         DO ji = kideb, kiut 
     754            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 
     755            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji) 
     756         END DO 
     757         ! 
     758      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed 
     759         ! 
     760         DO ji = kideb, kiut 
     761            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji) 
     762         END DO 
     763         ! 
     764      ENDIF 
     765 
     766      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 
     767      DO ji = kideb, kiut 
    749768         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    750769         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
     
    759778      CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 
    760779      CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 
    761       CALL wrk_dealloc( jpij, zdq, zq_ini ) 
     780      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
    762781 
    763782   END SUBROUTINE lim_thd_dif 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r4900 r4901  
    2929   USE lib_mpp        ! MPP library 
    3030   USE wrk_nemo       ! work arrays 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3132   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3233   USE limthd_ent 
     
    133134                  !Energy of melting q(S,T) [J.m-3] 
    134135                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    135                   e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i ) 
     136                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp ) 
    136137                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
    137138               END DO 
     
    171172         zgamafr = 0.03 
    172173 
    173          DO jj = 1, jpj 
    174             DO ji = 1, jpi 
    175  
     174         DO jj = 2, jpj 
     175            DO ji = 2, jpi 
    176176               IF ( qlead(ji,jj) < 0._wp ) THEN 
    177177                  !------------- 
     
    243243            END DO ! loop on ji ends 
    244244         END DO ! loop on jj ends 
     245      !  
     246      CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
     247      CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
    245248 
    246249      ENDIF ! End of computation of frazil ice collection thickness 
     
    255258      ! This occurs if open water energy budget is negative 
    256259      nbpac = 0 
     260      npac(:) = 0 
     261      ! 
    257262      DO jj = 1, jpj 
    258263         DO ji = 1, jpi 
     
    315320         ! Keep old ice areas and volume in memory 
    316321         !----------------------------------------- 
    317          zv_old(:,:) = zv_i_1d(:,:)  
    318          za_old(:,:) = za_i_1d(:,:) 
    319  
     322         zv_old(1:nbpac,:) = zv_i_1d(1:nbpac,:)  
     323         za_old(1:nbpac,:) = za_i_1d(1:nbpac,:) 
    320324         !---------------------- 
    321325         ! Thickness of new ice 
     
    324328            zh_newice(ji) = hiccrit 
    325329         END DO 
    326          IF( fraz_swi == 1 ) zh_newice(:) = hicol_b(:) 
     330         IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_b(1:nbpac) 
    327331 
    328332         !---------------------- 
     
    331335         SELECT CASE ( num_sal ) 
    332336         CASE ( 1 )                    ! Sice = constant  
    333             zs_newice(:) = bulk_sal 
     337            zs_newice(1:nbpac) = bulk_sal 
    334338         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    335339            DO ji = 1, nbpac 
     
    339343            END DO 
    340344         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    341             zs_newice(:) =   2.3 
     345            zs_newice(1:nbpac) =   2.3 
    342346         END SELECT 
    343347 
     
    472476               za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl)                
    473477               zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 
    474  
    475478               ! for remapping 
    476479               h_i_old (ji,nlay_i+1) = zv_newfra 
     
    479482 
    480483            ! --- Ice enthalpy remapping --- ! 
    481             IF( zv_newfra > 0._wp ) THEN 
    482                CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  
    483             ENDIF 
     484            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  
    484485 
    485486         ENDDO 
     
    534535               DO ji = 1, jpi 
    535536                  ! heat content in Joules 
    536                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac )  
     537                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac )  
    537538               END DO 
    538539            END DO 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4900 r4901  
    115115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom 
    116116 
    117    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
    118    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
    119  
    120117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
    121118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
     
    149146         &      qsr_ice_1d (jpij) ,     & 
    150147         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
    151          &      t_bo_b   (jpij) , iatte_1d  (jpij) , oatte_1d (jpij) ,     & 
     148         &      t_bo_b   (jpij) ,                                          & 
    152149         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 
    153150         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90

    r4897 r4901  
    5454   USE icbini          ! handle bergs, initialisation 
    5555   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    56 #if defined key_oasis3 
    5756   USE cpl_oasis3      ! OASIS3 coupling 
    58 #elif defined key_oasis4 
    59    USE cpl_oasis4      ! OASIS4 coupling (not working) 
    60 #endif 
    6157   USE lib_mpp         ! distributed memory computing 
    6258#if defined key_iomput 
     
    166162#if defined key_iomput 
    167163      IF( Agrif_Root() ) THEN 
    168 # if defined key_oasis3 || defined key_oasis4 
    169          CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    170          CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) 
    171 # else 
    172          CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    173 # endif 
     164         IF( lk_cpl ) THEN 
     165            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
     166            CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     167         ELSE 
     168            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     169         ENDIF 
     170      ENDIF 
    174171      ENDIF 
    175172      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    176173#else 
    177 # if defined key_oasis3 || defined key_oasis4 
    178       IF( Agrif_Root() ) THEN 
    179          CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis 
    180       ENDIF 
    181       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
    182 # else 
    183       ilocal_comm = 0 
    184       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    185 # endif 
     174      IF( lk_cpl ) THEN 
     175         IF( Agrif_Root() ) THEN 
     176            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
     177         ENDIF 
     178         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     179      ELSE 
     180         ilocal_comm = 0 
     181         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     182      ENDIF 
    186183#endif 
    187184      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r4147 r4901  
    77   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    88   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!---------------------------------------------------------------------- 
    10 #if ! defined key_coupled 
    11   
     9   !!----------------------------------------------------------------------  
    1210   !!---------------------------------------------------------------------- 
    1311   !!   Only for ORCA2 ORCA1 and ORCA025 
     
    2927 
    3028   PUBLIC dia_fwb    ! routine called by step.F90 
    31  
    32    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag 
    3329 
    3430   REAL(wp)               ::   a_fwf ,          & 
     
    453449   END SUBROUTINE dia_fwb 
    454450 
    455 #else 
    456    !!---------------------------------------------------------------------- 
    457    !!   Default option :                                       Dummy Module 
    458    !!---------------------------------------------------------------------- 
    459    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    !: fresh water budget flag 
    460 CONTAINS 
    461    SUBROUTINE dia_fwb( kt )        ! Empty routine 
    462       WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt 
    463    END SUBROUTINE dia_fwb 
    464 #endif 
    465  
    466451   !!====================================================================== 
    467452END MODULE diafwb 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4896 r4901  
    488488         ENDIF 
    489489 
    490 #if ! defined key_coupled  
    491          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    492             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    493          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    494             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    495          CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    496             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    497 #endif 
    498  
    499  
    500  
    501 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    502          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    503             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    504          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    505             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    506          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    507             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    508 #endif 
     490         IF( .NOT. lk_cpl ) THEN 
     491            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     492               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     493            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     494               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     495            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
     496               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     497         ENDIF 
     498 
     499         IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     500            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     501               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     502            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     503               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     504            CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
     505               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     506         ENDIF 
     507          
    509508         clmx ="l_max(only(x))"    ! max index on a period 
    510509         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
     
    521520#endif 
    522521 
    523 #if defined key_coupled  
    524 # if defined key_lim3 
    525          Must be adapted to LIM3 
    526 # endif  
    527 # if defined key_lim2 
    528          CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    529             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    530          CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    531             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    532 # endif  
    533 #endif  
     522         IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     523            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
     524               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     525            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
     526               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     527         ENDIF 
    534528 
    535529         CALL histend( nid_T, snc4chunks=snc4set ) 
     
    683677      ENDIF 
    684678 
    685 #if ! defined key_coupled 
    686       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    687       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    688       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    689       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    690 #endif 
    691 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    692       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    693       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     679      IF( .NOT. lk_cpl ) THEN 
     680         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     681         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    694682         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    695       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    696 #endif 
     683         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     684      ENDIF 
     685      IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     686         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     687         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     688         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     689         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     690      ENDIF 
    697691      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    698692      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
     
    705699#endif 
    706700 
    707 #if defined key_coupled  
    708 # if defined key_lim3 
    709       Must be adapted for LIM3 
    710       CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    711       CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
    712 # endif 
    713 # if defined key_lim2 
    714       CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    715       CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    716 # endif 
    717 #endif 
    718          ! Write fields on U grid 
     701      IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     702         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
     703         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
     704      ENDIF 
     705 
     706      ! Write fields on U grid 
    719707      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    720708      IF( ln_traldf_gdia ) THEN 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4900 r4901  
    134134#endif 
    135135                  IF( lk_lim3 ) THEN 
    136                      CALL iom_rstput( kt, nitrst, numrow, 'iatte'  , iatte     ) !clem modif 
    137                      CALL iom_rstput( kt, nitrst, numrow, 'oatte'  , oatte     ) !clem modif 
     136                     CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    138137                  ENDIF 
    139138      IF( kt == nitrst ) THEN 
     
    258257      ! 
    259258      IF( lk_lim3 ) THEN 
    260          CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 
    261          CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 
     259         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    262260      ENDIF 
    263261      ! 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r3294 r4901  
    22   !!====================================================================== 
    33   !!                    ***  MODULE cpl_oasis  *** 
    4    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 
    5    !!               special case: NEMO OPA/LIM coupled to ECHAM5 
     4   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 
    65   !!===================================================================== 
    76   !! History :    
     
    1514   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields 
    1615   !!---------------------------------------------------------------------- 
     16   !!---------------------------------------------------------------------- 
     17   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
     18   !!---------------------------------------------------------------------- 
     19   !!   cpl_init     : initialization of coupled mode communication 
     20   !!   cpl_define   : definition of grid and fields 
     21   !!   cpl_snd     : snd out fields in coupled mode 
     22   !!   cpl_rcv     : receive fields in coupled mode 
     23   !!   cpl_finalize : finalize the coupled mode communication 
     24   !!---------------------------------------------------------------------- 
    1725#if defined key_oasis3 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
    20    !!---------------------------------------------------------------------- 
    21    !!   cpl_prism_init     : initialization of coupled mode communication 
    22    !!   cpl_prism_define   : definition of grid and fields 
    23    !!   cpl_prism_snd     : snd out fields in coupled mode 
    24    !!   cpl_prism_rcv     : receive fields in coupled mode 
    25    !!   cpl_prism_finalize : finalize the coupled mode communication 
    26    !!---------------------------------------------------------------------- 
    27    USE mod_prism_proto              ! OASIS3 prism module 
    28    USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 
    29    USE mod_prism_put_proto          ! OASIS3 prism module for snding 
    30    USE mod_prism_get_proto          ! OASIS3 prism module for receiving 
    31    USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency 
     26   USE mod_oasis                    ! OASIS3-MCT module 
     27#endif 
    3228   USE par_oce                      ! ocean parameters 
    3329   USE dom_oce                      ! ocean space and time domain 
     
    3834   PRIVATE 
    3935 
    40    PUBLIC   cpl_prism_init 
    41    PUBLIC   cpl_prism_define 
    42    PUBLIC   cpl_prism_snd 
    43    PUBLIC   cpl_prism_rcv 
    44    PUBLIC   cpl_prism_freq 
    45    PUBLIC   cpl_prism_finalize 
    46  
    47    LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
     36   PUBLIC   cpl_init 
     37   PUBLIC   cpl_define 
     38   PUBLIC   cpl_snd 
     39   PUBLIC   cpl_rcv 
     40   PUBLIC   cpl_freq 
     41   PUBLIC   cpl_finalize 
     42 
    4843   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
    4944   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
    50    INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
     45   INTEGER                    ::   ncomp_id          ! id returned by oasis_init_comp 
    5146   INTEGER                    ::   nerror            ! return error code 
    52  
    53    INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
     47#if ! defined key_oasis3 
     48   ! OASIS Variables not used. defined only for compilation purpose 
     49   INTEGER                    ::   OASIS_Out         = -1 
     50   INTEGER                    ::   OASIS_REAL        = -1 
     51   INTEGER                    ::   OASIS_Ok          = -1 
     52   INTEGER                    ::   OASIS_In          = -1 
     53   INTEGER                    ::   OASIS_Sent        = -1 
     54   INTEGER                    ::   OASIS_SentOut     = -1 
     55   INTEGER                    ::   OASIS_ToRest      = -1 
     56   INTEGER                    ::   OASIS_ToRestOut   = -1 
     57   INTEGER                    ::   OASIS_Recvd       = -1 
     58   INTEGER                    ::   OASIS_RecvOut     = -1 
     59   INTEGER                    ::   OASIS_FromRest    = -1 
     60   INTEGER                    ::   OASIS_FromRestOut = -1 
     61#endif 
     62 
     63   INTEGER, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
     65   INTEGER, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    5466    
    5567   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
     
    5870      CHARACTER(len = 1)    ::   clgrid    ! Grid type   
    5971      REAL(wp)              ::   nsgn      ! Control of the sign change 
    60       INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories) 
     72      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models) 
    6173      INTEGER               ::   nct       ! Number of categories in field 
     74      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
    6275   END TYPE FLD_CPL 
    6376 
     
    7386CONTAINS 
    7487 
    75    SUBROUTINE cpl_prism_init( kl_comm ) 
     88   SUBROUTINE cpl_init( kl_comm ) 
    7689      !!------------------------------------------------------------------- 
    77       !!             ***  ROUTINE cpl_prism_init  *** 
     90      !!             ***  ROUTINE cpl_init  *** 
    7891      !! 
    7992      !! ** Purpose :   Initialize coupled mode communication for ocean 
     
    89102 
    90103      !------------------------------------------------------------------ 
    91       ! 1st Initialize the PRISM system for the application 
     104      ! 1st Initialize the OASIS system for the application 
    92105      !------------------------------------------------------------------ 
    93       CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror ) 
    94       IF ( nerror /= PRISM_Ok ) & 
    95          CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') 
     106      CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     107      IF ( nerror /= OASIS_Ok ) & 
     108         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    96109 
    97110      !------------------------------------------------------------------ 
     
    99112      !------------------------------------------------------------------ 
    100113 
    101       CALL prism_get_localcomm_proto ( kl_comm, nerror ) 
    102       IF ( nerror /= PRISM_Ok ) & 
    103          CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    104       ! 
    105    END SUBROUTINE cpl_prism_init 
    106  
    107  
    108    SUBROUTINE cpl_prism_define( krcv, ksnd ) 
     114      CALL oasis_get_localcomm ( kl_comm, nerror ) 
     115      IF ( nerror /= OASIS_Ok ) & 
     116         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     117      ! 
     118   END SUBROUTINE cpl_init 
     119 
     120 
     121   SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 
    109122      !!------------------------------------------------------------------- 
    110       !!             ***  ROUTINE cpl_prism_define  *** 
     123      !!             ***  ROUTINE cpl_define  *** 
    111124      !! 
    112125      !! ** Purpose :   Define grid and field information for ocean 
     
    116129      !!-------------------------------------------------------------------- 
    117130      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
     131      INTEGER, INTENT(in) ::   kcplmodel      ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    118132      ! 
    119133      INTEGER :: id_part 
    120134      INTEGER :: paral(5)       ! OASIS3 box partition 
    121135      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
    122       INTEGER :: ji,jc          ! local loop indicees 
    123       CHARACTER(LEN=8) :: zclname 
     136      INTEGER :: ji,jc,jm       ! local loop indicees 
     137      CHARACTER(LEN=64) :: zclname 
     138      CHARACTER(LEN=2) :: cli2 
    124139      !!-------------------------------------------------------------------- 
    125140 
    126141      IF(lwp) WRITE(numout,*) 
    127       IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case' 
     142      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 
    128143      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    129144      IF(lwp) WRITE(numout,*) 
    130145 
     146      IF( kcplmodel > nmaxcpl ) THEN 
     147         CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
     148      ENDIF 
    131149      ! 
    132150      ! ... Define the shape for the area that excludes the halo 
     
    141159      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
    142160      IF( nerror > 0 ) THEN 
    143          CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN 
     161         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    144162      ENDIF 
    145163      ! 
     
    161179      ENDIF 
    162180       
    163       CALL prism_def_partition_proto ( id_part, paral, nerror ) 
     181      CALL oasis_def_partition ( id_part, paral, nerror ) 
    164182      ! 
    165183      ! ... Announce send variables.  
    166184      ! 
     185      ssnd(:)%ncplmodel = kcplmodel 
     186      ! 
    167187      DO ji = 1, ksnd 
    168          IF ( ssnd(ji)%laction ) THEN  
     188         IF ( ssnd(ji)%laction ) THEN 
     189 
     190            IF( ssnd(ji)%nct > nmaxcat ) THEN 
     191               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
     192                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 
     193               RETURN 
     194            ENDIF 
     195             
    169196            DO jc = 1, ssnd(ji)%nct 
    170                IF ( ssnd(ji)%nct .gt. 1 ) THEN 
    171                   WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 
    172                ELSE 
    173                   zclname=ssnd(ji)%clname 
    174                ENDIF 
    175                WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 
    176                CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    177                     PRISM_Out, ishape, PRISM_REAL, nerror) 
    178                IF ( nerror /= PRISM_Ok ) THEN 
    179                   WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    180                   CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    181                ENDIF 
     197               DO jm = 1, kcplmodel 
     198 
     199                  IF ( ssnd(ji)%nct .GT. 1 ) THEN 
     200                     WRITE(cli2,'(i2.2)') jc 
     201                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 
     202                  ELSE 
     203                     zclname = ssnd(ji)%clname 
     204                  ENDIF 
     205                  IF ( kcplmodel  > 1 ) THEN 
     206                     WRITE(cli2,'(i2.2)') jm 
     207                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     208                  ENDIF 
     209#if defined key_agrif 
     210                  IF( agrif_fixed() /= 0 ) THEN  
     211                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
     212                  END IF 
     213#endif 
     214                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 
     215                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     216                     &                OASIS_Out          , ishape , OASIS_REAL, nerror ) 
     217                  IF ( nerror /= OASIS_Ok ) THEN 
     218                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     219                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     220                  ENDIF 
     221                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 
     222                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 
     223               END DO 
    182224            END DO 
    183225         ENDIF 
     
    188230      DO ji = 1, krcv 
    189231         IF ( srcv(ji)%laction ) THEN  
     232             
     233            IF( srcv(ji)%nct > nmaxcat ) THEN 
     234               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
     235                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 
     236               RETURN 
     237            ENDIF 
     238             
    190239            DO jc = 1, srcv(ji)%nct 
    191                IF ( srcv(ji)%nct .gt. 1 ) THEN 
    192                   WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 
    193                ELSE 
    194                   zclname=srcv(ji)%clname 
    195                ENDIF 
    196                WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
    197                CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    198                     &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    199                IF ( nerror /= PRISM_Ok ) THEN 
    200                   WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    201                   CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    202                ENDIF 
     240               DO jm = 1, kcplmodel 
     241                   
     242                  IF ( srcv(ji)%nct .GT. 1 ) THEN 
     243                     WRITE(cli2,'(i2.2)') jc 
     244                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 
     245                  ELSE 
     246                     zclname = srcv(ji)%clname 
     247                  ENDIF 
     248                  IF ( kcplmodel  > 1 ) THEN 
     249                     WRITE(cli2,'(i2.2)') jm 
     250                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     251                  ENDIF 
     252#if defined key_agrif 
     253                  IF( agrif_fixed() /= 0 ) THEN  
     254                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
     255                  END IF 
     256#endif 
     257                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
     258                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     259                     &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     260                  IF ( nerror /= OASIS_Ok ) THEN 
     261                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     262                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     263                  ENDIF 
     264                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 
     265                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 
     266 
     267               END DO 
    203268            END DO 
    204269         ENDIF 
     
    209274      !------------------------------------------------------------------ 
    210275       
    211       CALL prism_enddef_proto(nerror) 
    212       IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    213       ! 
    214    END SUBROUTINE cpl_prism_define 
     276      CALL oasis_enddef(nerror) 
     277      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
     278      ! 
     279   END SUBROUTINE cpl_define 
    215280    
    216281    
    217    SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo ) 
     282   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 
    218283      !!--------------------------------------------------------------------- 
    219       !!              ***  ROUTINE cpl_prism_snd  *** 
     284      !!              ***  ROUTINE cpl_snd  *** 
    220285      !! 
    221286      !! ** Purpose : - At each coupling time-step,this routine sends fields 
     
    227292      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata 
    228293      !! 
    229       INTEGER                                   ::   jc        ! local loop index 
     294      INTEGER                                   ::   jc,jm     ! local loop index 
    230295      !!-------------------------------------------------------------------- 
    231296      ! 
     
    233298      ! 
    234299      DO jc = 1, ssnd(kid)%nct 
    235  
    236          CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
    237           
    238          IF ( ln_ctl ) THEN         
    239             IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
    240                  & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
    241                WRITE(numout,*) '****************' 
    242                WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
    243                WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 
    244                WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
    245                WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
    246                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    247                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    248                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
    249                WRITE(numout,*) '****************' 
     300         DO jm = 1, ssnd(kid)%ncplmodel 
     301         
     302            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 
     303               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     304                
     305               IF ( ln_ctl ) THEN         
     306                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
     307                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
     308                     WRITE(numout,*) '****************' 
     309                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 
     310                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 
     311                     WRITE(numout,*) 'oasis_put:  kstep ', kstep 
     312                     WRITE(numout,*) 'oasis_put:   info ', kinfo 
     313                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     314                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     315                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     316                     WRITE(numout,*) '****************' 
     317                  ENDIF 
     318               ENDIF 
     319                
    250320            ENDIF 
    251          ENDIF 
    252  
     321             
     322         ENDDO 
    253323      ENDDO 
    254324      ! 
    255     END SUBROUTINE cpl_prism_snd 
    256  
    257  
    258    SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) 
     325    END SUBROUTINE cpl_snd 
     326 
     327 
     328   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 
    259329      !!--------------------------------------------------------------------- 
    260       !!              ***  ROUTINE cpl_prism_rcv  *** 
     330      !!              ***  ROUTINE cpl_rcv  *** 
    261331      !! 
    262332      !! ** Purpose : - At each coupling time-step,this routine receives fields 
     
    266336      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    267337      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
     338      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask 
    268339      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    269340      !! 
    270       INTEGER                                   ::   jc        ! local loop index 
    271       LOGICAL                                   ::   llaction 
     341      INTEGER                                   ::   jc,jm     ! local loop index 
     342      LOGICAL                                   ::   llaction, llfisrt 
    272343      !!-------------------------------------------------------------------- 
    273344      ! 
    274345      ! receive local data from OASIS3 on every process 
    275346      ! 
     347      kinfo = OASIS_idle 
     348      ! 
    276349      DO jc = 1, srcv(kid)%nct 
    277  
    278          CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )          
    279           
    280          llaction = .false. 
    281          IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    282               kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    283           
    284          IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 
    285           
    286          IF ( llaction ) THEN 
    287              
    288             kinfo = OASIS_Rcv 
    289             pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
    290              
    291             !--- Fill the overlap areas and extra hallows (mpp) 
    292             !--- check periodicity conditions (all cases) 
    293             CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
    294              
    295             IF ( ln_ctl ) THEN         
    296                WRITE(numout,*) '****************' 
    297                WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    298                WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc) 
    299                WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    300                WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
    301                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    302                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    303                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
    304                WRITE(numout,*) '****************' 
     350         llfisrt = .TRUE. 
     351 
     352         DO jm = 1, srcv(kid)%ncplmodel 
     353 
     354            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     355 
     356               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     357                
     358               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     359                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     360                
     361               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     362                
     363               IF ( llaction ) THEN 
     364                   
     365                  kinfo = OASIS_Rcv 
     366                  IF( llfisrt ) THEN  
     367                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     368                     llfisrt = .FALSE. 
     369                  ELSE 
     370                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     371                  ENDIF 
     372                   
     373                  IF ( ln_ctl ) THEN         
     374                     WRITE(numout,*) '****************' 
     375                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     376                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm) 
     377                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
     378                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
     379                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     380                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     381                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     382                     WRITE(numout,*) '****************' 
     383                  ENDIF 
     384                   
     385               ENDIF 
     386                
    305387            ENDIF 
    306388             
    307          ELSE 
    308             kinfo = OASIS_idle      
    309          ENDIF 
    310           
     389         ENDDO 
     390 
     391         !--- Fill the overlap areas and extra hallows (mpp) 
     392         !--- check periodicity conditions (all cases) 
     393         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     394  
    311395      ENDDO 
    312396      ! 
    313    END SUBROUTINE cpl_prism_rcv 
    314  
    315  
    316    INTEGER FUNCTION cpl_prism_freq( kid )   
     397   END SUBROUTINE cpl_rcv 
     398 
     399 
     400   INTEGER FUNCTION cpl_freq( kid )   
    317401      !!--------------------------------------------------------------------- 
    318       !!              ***  ROUTINE cpl_prism_freq  *** 
     402      !!              ***  ROUTINE cpl_freq  *** 
    319403      !! 
    320404      !! ** Purpose : - send back the coupling frequency for a particular field 
    321405      !!---------------------------------------------------------------------- 
    322       INTEGER,INTENT(in) ::   kid   ! variable index  
     406      INTEGER,INTENT(in) ::   kid   ! variable index 
     407      !! 
     408      INTEGER :: info 
    323409      !!---------------------------------------------------------------------- 
    324       cpl_prism_freq = ig_def_freq( kid ) 
    325       ! 
    326    END FUNCTION cpl_prism_freq 
    327  
    328  
    329    SUBROUTINE cpl_prism_finalize 
     410      CALL oasis_get_freqs(kid, 1, cpl_freq, info) 
     411      ! 
     412   END FUNCTION cpl_freq 
     413 
     414 
     415   SUBROUTINE cpl_finalize 
    330416      !!--------------------------------------------------------------------- 
    331       !!              ***  ROUTINE cpl_prism_finalize  *** 
     417      !!              ***  ROUTINE cpl_finalize  *** 
    332418      !! 
    333419      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 
    334       !!      called explicitly before cpl_prism_init it will also close 
     420      !!      called explicitly before cpl_init it will also close 
    335421      !!      MPI communication. 
    336422      !!---------------------------------------------------------------------- 
    337423      ! 
    338424      DEALLOCATE( exfld ) 
    339       CALL prism_terminate_proto( nerror )          
    340       ! 
    341    END SUBROUTINE cpl_prism_finalize 
    342  
    343 #else 
    344    !!---------------------------------------------------------------------- 
    345    !!   Default case          Dummy module          Forced Ocean/Atmosphere 
    346    !!---------------------------------------------------------------------- 
    347    USE in_out_manager               ! I/O manager 
    348    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag 
    349    PUBLIC cpl_prism_init 
    350    PUBLIC cpl_prism_finalize 
    351 CONTAINS 
    352    SUBROUTINE cpl_prism_init (kl_comm)  
    353       INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model 
    354       kl_comm = -1 
    355       WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
    356    END SUBROUTINE cpl_prism_init 
    357    SUBROUTINE cpl_prism_finalize 
    358       WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 
    359    END SUBROUTINE cpl_prism_finalize 
     425      IF (nstop == 0) THEN 
     426         CALL oasis_terminate( nerror )          
     427      ELSE 
     428         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 
     429      ENDIF        
     430      ! 
     431   END SUBROUTINE cpl_finalize 
     432 
     433#if ! defined key_oasis3 
     434 
     435   !!---------------------------------------------------------------------- 
     436   !!   No OASIS Library          OASIS3 Dummy module... 
     437   !!---------------------------------------------------------------------- 
     438 
     439   SUBROUTINE oasis_init_comp(k1,cd1,k2) 
     440      CHARACTER(*), INTENT(in   ) ::  cd1 
     441      INTEGER     , INTENT(  out) ::  k1,k2 
     442      k1 = -1 ; k2 = -1 
     443      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 
     444   END SUBROUTINE oasis_init_comp 
     445 
     446   SUBROUTINE oasis_abort(k1,cd1,cd2) 
     447      INTEGER     , INTENT(in   ) ::  k1 
     448      CHARACTER(*), INTENT(in   ) ::  cd1,cd2 
     449      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 
     450   END SUBROUTINE oasis_abort 
     451 
     452   SUBROUTINE oasis_get_localcomm(k1,k2) 
     453      INTEGER     , INTENT(  out) ::  k1,k2 
     454      k1 = -1 ; k2 = -1 
     455      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 
     456   END SUBROUTINE oasis_get_localcomm 
     457 
     458   SUBROUTINE oasis_def_partition(k1,k2,k3) 
     459      INTEGER     , INTENT(  out) ::  k1,k3 
     460      INTEGER     , INTENT(in   ) ::  k2(5) 
     461      k1 = k2(1) ; k3 = k2(5) 
     462      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 
     463   END SUBROUTINE oasis_def_partition 
     464 
     465   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
     466      CHARACTER(*), INTENT(in   ) ::  cd1 
     467      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     468      INTEGER     , INTENT(  out) ::  k1,k7 
     469      k1 = -1 ; k7 = -1 
     470      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 
     471   END SUBROUTINE oasis_def_var 
     472 
     473   SUBROUTINE oasis_enddef(k1) 
     474      INTEGER     , INTENT(  out) ::  k1 
     475      k1 = -1 
     476      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 
     477   END SUBROUTINE oasis_enddef 
     478   
     479   SUBROUTINE oasis_put(k1,k2,p1,k3) 
     480      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1 
     481      INTEGER                 , INTENT(in   ) ::  k1,k2 
     482      INTEGER                 , INTENT(  out) ::  k3 
     483      k3 = -1 
     484      WRITE(numout,*) 'oasis_put: Error you sould not be there...' 
     485   END SUBROUTINE oasis_put 
     486 
     487   SUBROUTINE oasis_get(k1,k2,p1,k3) 
     488      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
     489      INTEGER                 , INTENT(in   ) ::  k1,k2 
     490      INTEGER                 , INTENT(  out) ::  k3 
     491      p1(1,1) = -1. ; k3 = -1 
     492      WRITE(numout,*) 'oasis_get: Error you sould not be there...' 
     493   END SUBROUTINE oasis_get 
     494 
     495   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 
     496      INTEGER     , INTENT(in   ) ::  k1,k2 
     497      INTEGER     , INTENT(  out) ::  k3,k4 
     498      k3 = k1 ; k4 = k2 
     499      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 
     500   END SUBROUTINE oasis_get_freqs 
     501 
     502   SUBROUTINE oasis_terminate(k1) 
     503      INTEGER     , INTENT(  out) ::  k1 
     504      k1 = -1 
     505      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 
     506   END SUBROUTINE oasis_terminate 
     507    
    360508#endif 
    361509 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r4306 r4901  
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce          ! ocean parameters 
     16   USE sbc_oce          ! surface boundary condition: ocean 
    1617# if defined key_lim3 
    1718   USE par_ice          ! LIM-3 parameters 
     
    5657 
    5758#if defined key_lim3 || defined key_lim2  
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice       !: non solar heat flux over ice                  [W/m2] 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice       !: solar heat flux over ice                      [W/m2] 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean  !: dauly mean solar heat flux over ice       [W/m2] 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice       !: latent flux over ice                          [W/m2] 
    62    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice      !: latent sensibility over ice                 [W/m2/K] 
    63    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice      !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice        !: ice surface temperature                          [K] 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice       !: albedo of ice 
    66  
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice  !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice  !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0    !: 1st Qsr fraction penetrating inside ice cover    [-] 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0    !: 2nd Qsr fraction penetrating inside ice cover    [-] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice   !: sublimation-snow budget over ice             [kg/m2] 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2] 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2] 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2] 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2] 
     63   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K] 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice       !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice         !: ice surface temperature                          [K] 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-] 
     67 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat associated with emp over sea ice         [W/m2] 
    7274 
    7375# if defined key_lim3 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice  !: air temperature 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    7577# endif 
    7678 
     
    98100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    99101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
    100 #endif 
     102 
     103   ! variables used in the coupled interface 
     104   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     109#endif 
     110    
     111#if defined key_lim2 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     113#endif 
     114 
     115#if ! defined key_lim3 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     117#endif 
     118 
     119#if ! defined key_cice 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
     121#endif 
     122 
     123   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
    101124 
    102125   !!---------------------------------------------------------------------- 
     
    111134      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    112135      !!---------------------------------------------------------------------- 
    113       INTEGER :: ierr(2) 
     136      INTEGER :: ierr(5) 
    114137      !!---------------------------------------------------------------------- 
    115138      ierr(:) = 0 
     
    123146         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    124147#if defined key_lim3 
    125          &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= ierr(1) ) 
    126 #else 
    127          &      emp_ice(jpi,jpj)                              , STAT= ierr(1) ) 
    128 #endif 
     148         &      tatm_ice(jpi,jpj)     ,                             & 
     149#endif 
     150         &      emp_ice(jpi,jpj)      , qemp_ice(jpi,jpj)     , STAT= ierr(1) ) 
    129151#elif defined key_cice 
    130152      ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
     
    132154                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
    133155                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    134                 a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) ) 
     156                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
     157                STAT= ierr(1) ) 
     158      IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     159         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
     160         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     161         &                     STAT= ierr(2) ) 
     162       
    135163#endif 
    136164         ! 
    137165#if defined key_lim2 
    138       IF( ltrcdm2dc_ice )THEN 
    139          ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 
    140       ENDIF 
     166      IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    141167#endif 
    142168         ! 
     169#if defined key_lim2 
     170      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(4) ) 
     171#endif 
     172 
     173#if defined key_cice || defined key_lim2 
     174      IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     175#endif 
     176 
    143177      sbc_ice_alloc = MAXVAL( ierr ) 
    144178      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
     
    150184   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    151185   !!---------------------------------------------------------------------- 
     186   USE in_out_manager   ! I/O manager 
    152187   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    153188   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    154189   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    155190   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
     191   REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     192   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
     193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     195   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i 
     196   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     197   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     198   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s 
     199   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
    156200#endif 
    157201 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4306 r4901  
    3535   LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation 
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
    37    LOGICAL , PUBLIC ::   ln_cpl         !: coupled   formulation (overwritten by key_sbc_coupled ) 
     37#if defined key_oasis3 
     38   LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation 
     39#else 
     40   LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation 
     41#endif 
    3842   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    3943   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
     
    4549   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    4650   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
     51   INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation 
     52   !                                             !: =-1  Use of per-category fluxes 
     53   !                                             !: = 0  Average per-category fluxes 
     54   !                                             !: = 1  Average then redistribute per-category fluxes 
     55   !                                             !: = 2  Redistribute a single flux over categories 
    4756   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:  
    4857   !                                             !:  = 0 unchecked  
     
    5564   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs 
    5665   ! 
    57    CHARACTER (len=8), PUBLIC :: cn_iceflx  !: Flux handling over ice categories 
    58    LOGICAL, PUBLIC :: ln_iceflx_ave     ! Average heat fluxes over all ice categories 
    59    LOGICAL, PUBLIC :: ln_iceflx_linear  ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 
    60    ! 
    61    INTEGER , PUBLIC ::   nn_lsm        !: Number of iteration if seaoverland is applied 
     66   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied 
     67   !!---------------------------------------------------------------------- 
     68   !!           switch definition (improve readability) 
     69   !!---------------------------------------------------------------------- 
     70   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation 
     71   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation 
     72   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation 
     73   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation 
     75   INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations 
     78    
    6279   !!---------------------------------------------------------------------- 
    6380   !!              Ocean Surface Boundary Condition fields 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r4897 r4901  
    114114      !!              - utau, vtau  i- and j-component of the wind stress 
    115115      !!              - taum        wind stress module at T-point 
    116       !!              - wndm        10m wind module at T-point 
     116      !!              - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice 
    117117      !!              - qns         non-solar heat flux including latent heat of solid  
    118118      !!                            precip. melting and emp heat content 
     
    204204      !!               - utau, vtau  i- and j-component of the wind stress 
    205205      !!               - taum        wind stress module at T-point 
    206       !!               - wndm        10m wind module at T-point 
     206      !!               - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice 
    207207      !!               - qns         non-solar heat flux including latent heat of solid  
    208208      !!                             precip. melting and emp heat content 
     
    398398 
    399399 
    400    SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os ,       & 
     400   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  & 
    401401      &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    402402      &                      p_qla , p_dqns, p_dqla,          & 
     
    427427      !!---------------------------------------------------------------------- 
    428428      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    429       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    430       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [%] 
     429      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
     430      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
     431      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-] 
    431432      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    432433      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
     
    438439      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
    439440      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
    440       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%] 
    441       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%] 
     441      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-] 
     442      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-] 
    442443      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    443444      INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories 
     
    542543      !-----------------------------------------------------------! 
    543544      CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
     545       
     546      DO jl = 1, ijpl 
     547         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) )   & 
     548            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(ji,jj,1) ) 
     549      END DO 
    544550 
    545551      !                                     ! ========================== ! 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4898 r4901  
    4444   USE prtctl          ! Print control 
    4545   USE sbcwave, ONLY   :  cdn_wave ! wave module 
    46 #if defined key_lim3 || defined key_cice 
    4746   USE sbc_ice         ! Surface boundary condition: ice fields 
    48 #endif 
    4947   USE lib_fortran     ! to use key_nosignedzero 
    5048 
     
    121119      !! ** Action  :   defined at each time-step at the air-sea interface 
    122120      !!              - utau, vtau  i- and j-component of the wind stress 
    123       !!              - taum, wndm  wind stress and 10m wind modules at T-point 
     121      !!              - taum        wind stress module at T-point 
     122      !!              - wndm        wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    124123      !!              - qns, qsr    non-solar and solar heat fluxes 
    125124      !!              - emp         upward mass flux (evapo. - precip.) 
     
    232231      !!              - qsr     : Solar heat flux over the ocean        (W/m2) 
    233232      !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    234       !!              - evap    : Evaporation over the ocean            (kg/m2/s) 
    235233      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    236234      !! 
     
    425423      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    426424      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    427       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     425      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    428426      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    429427      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
     
    445443      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    446444      REAL(wp) ::   zztmp                                        ! temporary variable 
    447       REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount 
    448445      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    449446      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
     
    469466      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    470467      zcoef_dqsb   = rhoa * cpa * Cice 
    471       zcoef_frca   = 1.0  - 0.3 
    472468 
    473469!!gm brutal.... 
     
    587583      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    588584 
    589       p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca ) 
    590       p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca ) 
     585      p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     586      p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    591587 
    592588      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r4897 r4901  
    8282      !!              - utau, vtau  i- and j-component of the wind stress 
    8383      !!              - taum        wind stress module at T-point 
    84       !!              - wndm        10m wind module at T-point 
     84      !!              - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice 
    8585      !!              - qns, qsr    non-slor and solar heat flux 
    8686      !!              - emp         evaporation minus precipitation 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4897 r4901  
    99   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_oasis3 || defined key_oasis4 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation 
    1411   !!---------------------------------------------------------------------- 
    1512   !!   namsbc_cpl      : coupled formulation namlist 
     
    3431   USE ice_2           ! ice variables 
    3532#endif 
    36 #if defined key_oasis3 
    3733   USE cpl_oasis3      ! OASIS3 coupling 
    38 #endif 
    39 #if defined key_oasis4 
    40    USE cpl_oasis4      ! OASIS4 coupling 
    41 #endif 
    4234   USE geo2ocean       !  
    4335   USE oce   , ONLY : tsn, un, vn 
     
    5850   IMPLICIT NONE 
    5951   PRIVATE 
    60  
     52!EM XIOS-OASIS-MCT compliance 
     53   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    6154   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
    6255   PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
     
    129122   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    130123   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     124   ! Other namelist parameters                        ! 
     125   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     126   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
     127                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     128 
     129   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    131130 
    132131   TYPE ::   DYNARR      
     
    139138 
    140139   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    141  
    142 #if ! defined key_lim2   &&   ! defined key_lim3 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
    144    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    145 #endif 
    146  
    147 #if defined key_cice 
    148    INTEGER, PARAMETER ::   jpl = ncat 
    149 #elif ! defined key_lim2   &&   ! defined key_lim3 
    150    INTEGER, PARAMETER ::   jpl = 1  
    151    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    153 #endif 
    154  
    155 #if ! defined key_lim3   &&  ! defined key_cice 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    157 #endif 
    158  
    159 #if ! defined key_lim3 
    160    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    161 #endif 
    162  
    163 #if ! defined key_cice 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    165 #endif 
    166140 
    167141   !! Substitution 
     
    179153      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    180154      !!---------------------------------------------------------------------- 
    181       INTEGER :: ierr(4),jn 
     155      INTEGER :: ierr(3) 
    182156      !!---------------------------------------------------------------------- 
    183157      ierr(:) = 0 
    184158      ! 
    185159      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    186       ! 
    187 #if ! defined key_lim2 && ! defined key_lim3 
    188       ! quick patch to be able to run the coupled model without sea-ice... 
    189       ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
    190                 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
    191                 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     160       
     161#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     162      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) 
    192163#endif 
    193  
    194 #if ! defined key_lim3 && ! defined key_cice 
    195       ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
    196 #endif 
    197  
    198 #if defined key_cice || defined key_lim2 
    199       ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    200 #endif 
     164      ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     165      ! 
    201166      sbc_cpl_alloc = MAXVAL( ierr ) 
    202167      IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc ) 
     
    210175      !!             ***  ROUTINE sbc_cpl_init  *** 
    211176      !! 
    212       !! ** Purpose :   Initialisation of send and recieved information from 
     177      !! ** Purpose :   Initialisation of send and received information from 
    213178      !!                the atmospheric component 
    214179      !! 
     
    222187      INTEGER ::   jn   ! dummy loop index 
    223188      INTEGER ::   ios  ! Local integer output status for namelist read 
     189      INTEGER ::   inum  
    224190      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    225191      !! 
    226       NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
    227          &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
    228          &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
     192      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      & 
     193         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
     194         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
     195         &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
    229196      !!--------------------------------------------------------------------- 
    230197      ! 
     
    274241         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    275242         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     243         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     244         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    276245      ENDIF 
    277246 
     
    604573      ! ================================ ! 
    605574 
    606       CALL cpl_prism_define(jprcv, jpsnd)             
    607       ! 
    608       IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   & 
     575      CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     576      IF (ln_usecplmask) THEN  
     577         xcplmask(:,:,:) = 0. 
     578         CALL iom_open( 'cplmask', inum ) 
     579         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   & 
     580            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 
     581         CALL iom_close( inum ) 
     582      ELSE 
     583         xcplmask(:,:,:) = 1. 
     584      ENDIF 
     585      ! 
     586      IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
    609587         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    610588 
     
    654632      !! 
    655633      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
    656       !!                        taum, wndm   wind stres and wind speed module at T-point 
     634      !!                        taum         wind stress module at T-point 
     635      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    657636      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case) 
    658637      !!                                     and the latent heat flux of solid precip. melting 
     
    678657      ! 
    679658      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    680  
    681       IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    682  
    683659      !                                                 ! Receive all the atmos. fields (including ice information) 
    684660      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    685661      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    686          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
     662         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
    687663      END DO 
    688664 
     
    848824         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    849825         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    850          ! add the latent heat of solid precip. melting 
    851          IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
    852               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
    853            &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
     826         ! update qns over the free ocean with: 
     827         qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
     828         IF( srcv(jpr_snow  )%laction )   THEN 
     829              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
    854830         ENDIF 
    855831 
     
    914890      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    915891 
    916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 
    917       IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1    
     892      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    918893      ELSE                                ;   itx =  jpr_otx1 
    919894      ENDIF 
     
    922897      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    923898 
    924          !                                                                                              ! ======================= ! 
    925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 
    926          IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   ! 
    927             !                                                                                           ! ======================= ! 
     899         !                                                      ! ======================= ! 
     900         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     901            !                                                   ! ======================= ! 
    928902            !   
    929903            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     
    11251099      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11261100      ! optional arguments, used only in 'mixed oce-ice' case 
    1127       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    1128       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
     1101      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
     1102      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    11291103      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    11301104      ! 
     
    12961270      ENDIF 
    12971271 
    1298       SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
     1272      !                                                      ! ========================= ! 
     1273      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        ! 
     1274      !                                                      ! ========================= ! 
    12991275      CASE ('coupled') 
    13001276         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     
    13081284      END SELECT 
    13091285 
    1310       SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1286      !                                                      ! ========================= ! 
     1287      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     1288      !                                                      ! ========================= ! 
    13111289      CASE ('coupled') 
    13121290         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     
    13141292      END SELECT 
    13151293 
    1316       !    Ice Qsr penetration used (only?)in lim2 or lim3  
    1317       ! fraction of net shortwave radiation which is not absorbed in the thin surface layer  
    1318       ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
     1294      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 
     1295      ! Used for LIM2 and LIM3 
    13191296      ! Coupled case: since cloud cover is not received from atmosphere  
    1320       !               ===> defined as constant value -> definition done in sbc_cpl_init 
    1321       fr1_i0(:,:) = 0.18 
    1322       fr2_i0(:,:) = 0.82 
    1323  
     1297      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
     1298      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     1299      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13241300 
    13251301      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     
    13361312      !! ** Purpose :   provide the ocean-ice informations to the atmosphere 
    13371313      !! 
    1338       !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd 
     1314      !! ** Method  :   send to the atmosphere through a call to cpl_snd 
    13391315      !!              all the needed fields (as defined in sbc_cpl_init) 
    13401316      !!---------------------------------------------------------------------- 
     
    13551331 
    13561332      zfr_l(:,:) = 1.- fr_i(:,:) 
    1357  
    13581333      !                                                      ! ------------------------- ! 
    13591334      !                                                      !    Surface temperature    !   in Kelvin 
     
    13801355         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13811356         END SELECT 
    1382          IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1383          IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
    1384          IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1385       ENDIF 
    1386       ! 
     1357         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1358         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     1359         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1360      ENDIF 
    13871361      !                                                      ! ------------------------- ! 
    13881362      !                                                      !           Albedo          ! 
     
    13901364      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    13911365         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1392          CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 
     1366         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    13931367      ENDIF 
    13941368      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
     
    13971371            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 
    13981372         ENDDO 
    1399          CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1373         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    14001374      ENDIF 
    14011375      !                                                      ! ------------------------- ! 
     
    14091383         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    14101384         END SELECT 
    1411          CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1385         CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
    14121386      ENDIF 
    14131387 
     
    14341408         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14351409         END SELECT 
    1436          IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
    1437          IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
     1410         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info ) 
     1411         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 
    14381412      ENDIF 
    14391413      ! 
     
    14421416      !                                                      !  CO2 flux from PISCES     !  
    14431417      !                                                      ! ------------------------- ! 
    1444       IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
     1418      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
    14451419      ! 
    14461420#endif 
     
    15651539         ENDIF 
    15661540         ! 
    1567          IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
    1568          IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
    1569          IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
     1541         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     1542         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     1543         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
    15701544         ! 
    1571          IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
    1572          IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
    1573          IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
     1545         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
     1546         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
     1547         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    15741548         !  
    15751549      ENDIF 
     
    15821556   END SUBROUTINE sbc_cpl_snd 
    15831557    
    1584 #else 
    1585    !!---------------------------------------------------------------------- 
    1586    !!   Dummy module                                            NO coupling 
    1587    !!---------------------------------------------------------------------- 
    1588    USE par_kind        ! kind definition 
    1589 CONTAINS 
    1590    SUBROUTINE sbc_cpl_snd( kt ) 
    1591       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt 
    1592    END SUBROUTINE sbc_cpl_snd 
    1593    ! 
    1594    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )      
    1595       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice 
    1596    END SUBROUTINE sbc_cpl_rcv 
    1597    ! 
    1598    SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )      
    1599       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    1600       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    1601       p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling... 
    1602       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?' 
    1603    END SUBROUTINE sbc_cpl_ice_tau 
    1604    ! 
    1605    SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
    1606       REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1] 
    1607       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    1608       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    1609       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    1610       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1611    END SUBROUTINE sbc_cpl_ice_flx 
    1612     
    1613 #endif 
    1614  
    16151558   !!====================================================================== 
    16161559END MODULE sbccpl 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r4897 r4901  
    9595   END FUNCTION sbc_ice_cice_alloc 
    9696 
    97    SUBROUTINE sbc_ice_cice( kt, nsbc ) 
     97   SUBROUTINE sbc_ice_cice( kt, ksbc ) 
    9898      !!--------------------------------------------------------------------- 
    9999      !!                  ***  ROUTINE sbc_ice_cice  *** 
     
    113113      !!--------------------------------------------------------------------- 
    114114      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    115       INTEGER, INTENT(in) ::   nsbc    ! surface forcing type 
     115      INTEGER, INTENT(in) ::   ksbc    ! surface forcing type 
    116116      !!---------------------------------------------------------------------- 
    117117      ! 
     
    123123 
    124124         ! Make sure any fluxes required for CICE are set 
    125          IF ( nsbc == 2 ) THEN 
     125         IF      ( ksbc == jp_flx ) THEN 
    126126            CALL cice_sbc_force(kt) 
    127          ELSE IF ( nsbc == 5 ) THEN 
     127         ELSE IF ( ksbc == jp_cpl ) THEN 
    128128            CALL sbc_cpl_ice_flx( 1.0-fr_i  ) 
    129129         ENDIF 
    130130 
    131          CALL cice_sbc_in ( kt, nsbc ) 
     131         CALL cice_sbc_in  ( kt, ksbc ) 
    132132         CALL CICE_Run 
    133          CALL cice_sbc_out ( kt, nsbc ) 
    134  
    135          IF ( nsbc == 5 )  CALL cice_sbc_hadgam(kt+1) 
     133         CALL cice_sbc_out ( kt, ksbc ) 
     134 
     135         IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1) 
    136136 
    137137      ENDIF                                          ! End sea-ice time step only 
     
    141141   END SUBROUTINE sbc_ice_cice 
    142142 
    143    SUBROUTINE cice_sbc_init (nsbc) 
     143   SUBROUTINE cice_sbc_init (ksbc) 
    144144      !!--------------------------------------------------------------------- 
    145145      !!                    ***  ROUTINE cice_sbc_init  *** 
    146146      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    147147      !! 
    148       INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type 
     148      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
    149149      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
    150150      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
     
    165165 
    166166! Do some CICE consistency checks 
    167       IF ( (nsbc == 2) .OR. (nsbc == 5) ) THEN 
     167      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
    168168         IF ( calc_strair .OR. calc_Tsfc ) THEN 
    169169            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    170170         ENDIF 
    171       ELSEIF (nsbc == 4) THEN 
     171      ELSEIF (ksbc == jp_core) THEN 
    172172         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
    173173            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 
     
    190190 
    191191      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    192       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     192      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
    193193         DO jl=1,ncat 
    194194            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     
    232232 
    233233    
    234    SUBROUTINE cice_sbc_in (kt, nsbc) 
     234   SUBROUTINE cice_sbc_in (kt, ksbc) 
    235235      !!--------------------------------------------------------------------- 
    236236      !!                    ***  ROUTINE cice_sbc_in  *** 
     
    238238      !!--------------------------------------------------------------------- 
    239239      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    240       INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
     240      INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type 
    241241 
    242242      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
     
    262262! forced and coupled case  
    263263 
    264       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     264      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
    265265 
    266266         ztmpn(:,:,:)=0.0 
     
    287287 
    288288! Surface downward latent heat flux (CI_5) 
    289          IF (nsbc == 2) THEN 
     289         IF (ksbc == jp_flx) THEN 
    290290            DO jl=1,ncat 
    291291               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
     
    316316! GBM conductive flux through ice (CI_6) 
    317317!  Convert to GBM 
    318             IF (nsbc == 2) THEN 
     318            IF (ksbc == jp_flx) THEN 
    319319               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    320320            ELSE 
     
    325325! GBM surface heat flux (CI_7) 
    326326!  Convert to GBM 
    327             IF (nsbc == 2) THEN 
     327            IF (ksbc == jp_flx) THEN 
    328328               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    329329            ELSE 
     
    333333         ENDDO 
    334334 
    335       ELSE IF (nsbc == 4) THEN 
     335      ELSE IF (ksbc == jp_core) THEN 
    336336 
    337337! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) 
     
    458458 
    459459 
    460    SUBROUTINE cice_sbc_out (kt,nsbc) 
     460   SUBROUTINE cice_sbc_out (kt,ksbc) 
    461461      !!--------------------------------------------------------------------- 
    462462      !!                    ***  ROUTINE cice_sbc_out  *** 
     
    464464      !!--------------------------------------------------------------------- 
    465465      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    466       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
     466      INTEGER, INTENT( in  ) ::   ksbc ! surface forcing type 
    467467       
    468468      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
     
    510510! Freshwater fluxes  
    511511 
    512       IF (nsbc == 2) THEN 
     512      IF (ksbc == jp_flx) THEN 
    513513! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 
    514514! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below 
     
    516516! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    517517         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    518       ELSE IF (nsbc == 4) THEN 
     518      ELSE IF (ksbc == jp_core) THEN 
    519519         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    520       ELSE IF (nsbc ==5) THEN 
     520      ELSE IF (ksbc == jp_cpl) THEN 
    521521! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    522522! This is currently as required with the coupling fields from the UM atmosphere 
     
    543543! Scale qsr and qns according to ice fraction (bulk formulae only) 
    544544 
    545       IF (nsbc == 4) THEN 
     545      IF (ksbc == jp_core) THEN 
    546546         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 
    547547         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 
    548548      ENDIF 
    549549! Take into account snow melting except for fully coupled when already in qns_tot 
    550       IF (nsbc == 5) THEN 
     550      IF (ksbc == jp_cpl) THEN 
    551551         qsr(:,:)= qsr_tot(:,:) 
    552552         qns(:,:)= qns_tot(:,:) 
     
    575575 
    576576      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    577       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     577      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
    578578         DO jl=1,ncat 
    579579            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     
    611611 
    612612 
    613 #if defined key_oasis3 || defined key_oasis4 
    614613   SUBROUTINE cice_sbc_hadgam( kt ) 
    615614      !!--------------------------------------------------------------------- 
     
    653652   END SUBROUTINE cice_sbc_hadgam 
    654653 
    655 #else 
    656    SUBROUTINE cice_sbc_hadgam( kt )    ! Dummy routine 
    657       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    658       WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?' 
    659    END SUBROUTINE cice_sbc_hadgam 
    660 #endif 
    661654 
    662655   SUBROUTINE cice_sbc_final 
     
    1001994CONTAINS 
    1002995 
    1003    SUBROUTINE sbc_ice_cice ( kt, nsbc )     ! Dummy routine 
     996   SUBROUTINE sbc_ice_cice ( kt, ksbc )     ! Dummy routine 
    1004997      WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 
    1005998   END SUBROUTINE sbc_ice_cice 
    1006999 
    1007    SUBROUTINE cice_sbc_init (nsbc)    ! Dummy routine 
     1000   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine 
    10081001      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 
    10091002   END SUBROUTINE cice_sbc_init 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4897 r4901  
    1616   USE eosbn2         ! equation of state 
    1717   USE sbc_oce        ! surface boundary condition: ocean fields 
    18    USE sbccpl 
     18#if defined key_lim3 
     19   USE ice    , ONLY :   a_i  
     20#else 
     21   USE sbc_ice, ONLY :   a_i  
     22#endif 
    1923   USE fldread        ! read input field 
    2024   USE iom            ! I/O manager library 
     
    101105         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    102106 
    103 !!OM : probleme. a_i pas defini dans les cas lim3 et cice 
    104 !!gm  Not sure at all that a_i  should be defined....   ==>>> to be checked 
    105 #if defined key_coupled && defined key_lim2 
    106          a_i(:,:,1) = fr_i(:,:)          
    107 #endif 
     107         IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)          
    108108 
    109109         ! Flux and ice fraction computation 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4897 r4901  
    9393      !! 
    9494      INTEGER  ::   ji, jj   ! dummy loop indices 
    95       REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
    96       REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
    97       REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K) 
     95      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky 
     96      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky 
     97      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo 
     98      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K) 
    9899      !!---------------------------------------------------------------------- 
    99100 
    100       CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
     101      CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    101102 
    102103      IF( kt == nit000 ) THEN 
     
    144145         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 
    145146 
    146          ! ... ice albedo (clear sky and overcast sky) 
     147         ! Ice albedo 
     148 
    147149         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 
    148150                                 reshape( hsnif, (/jpi,jpj,1/) ), & 
    149                           zalb_ice_cs, zalb_ice_os ) 
     151                          zalb_cs, zalb_os ) 
     152 
     153         SELECT CASE( ksbc ) 
     154         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     155 
     156            ! albedo depends on cloud fraction because of non-linear spectral effects 
     157            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     158            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     159            ! (zalb_ice) is computed within the bulk routine 
     160 
     161         END SELECT 
    150162 
    151163         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
     
    163175         ! 
    164176         SELECT CASE( ksbc ) 
    165          CASE( 3 )           ! CLIO bulk formulation 
    166             CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         & 
     177         CASE( jp_clio )           ! CLIO bulk formulation 
     178            CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    167179               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    168180               &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
     
    170182               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    171183 
    172          CASE( 4 )           ! CORE bulk formulation 
    173             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            & 
     184         CASE( jp_core )           ! CORE bulk formulation 
     185            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    174186               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    175187               &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    176188               &                      tprecip    , sprecip    ,                         & 
    177189               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    178             IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice_cs, qsr_ice_mean, jpl ) 
    179  
    180          CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
     190            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
     191 
     192         CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    181193            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    182194         END SELECT 
     
    206218           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
    207219         END IF 
    208 #if defined key_coupled 
    209220         !                                             ! Ice surface fluxes in coupled mode  
    210          IF( ksbc == 5 )   THEN 
     221         IF( ksbc == jp_cpl )   THEN 
    211222            a_i(:,:,1)=fr_i 
    212223            CALL sbc_cpl_ice_flx( frld,                                              & 
    213224            !                                optional arguments, used only in 'mixed oce-ice' case 
    214             &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
     225            &                                             palbi = zalb_ice, psst = sst_m, pist = zsist ) 
    215226            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    216227         ENDIF 
    217 #endif 
    218228                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    219229                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
     
    245255      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    246256      ! 
    247       CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
     257      CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    248258      ! 
    249259   END SUBROUTINE sbc_ice_lim_2 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4897 r4901  
    3737   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3838   USE sbccpl           ! surface boundary condition: coupled florulation 
    39    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    4039   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4140   USE sbcrnf           ! surface boundary condition: runoffs 
     
    8281      INTEGER ::   icpt   ! local integer 
    8382      !! 
    84       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     83      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    8584         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    86          &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, cn_iceflx 
     85         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
    8786      INTEGER  ::   ios 
    8887      !!---------------------------------------------------------------------- 
     
    123122         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124123         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    125          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
    126          WRITE(numout,*) '              Flux handling over ice categories          cn_iceflx   = ', TRIM (cn_iceflx) 
     124         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     125         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    127126         WRITE(numout,*) '           Misc. options of sbc : ' 
    128127         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
     
    137136      ENDIF 
    138137 
    139       !   Flux handling over ice categories 
    140 #if defined key_coupled  
    141       SELECT CASE ( TRIM (cn_iceflx)) 
    142       CASE ('ave') 
    143          ln_iceflx_ave    = .TRUE. 
    144          ln_iceflx_linear = .FALSE. 
    145       CASE ('linear') 
    146          ln_iceflx_ave    = .FALSE. 
    147          ln_iceflx_linear = .TRUE. 
    148       CASE default 
    149          ln_iceflx_ave    = .FALSE. 
    150          ln_iceflx_linear = .FALSE. 
     138      ! LIM3 Multi-category heat flux formulation 
     139      SELECT CASE ( nn_limflx) 
     140      CASE ( -1 ) 
     141         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) ' 
     142      CASE ( 0  ) 
     143         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) '  
     144      CASE ( 1  ) 
     145         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) ' 
     146      CASE ( 2  ) 
     147         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) ' 
    151148      END SELECT 
    152       IF(lwp) WRITE(numout,*) '              Fluxes averaged over all ice categories         ln_iceflx_ave    = ', ln_iceflx_ave 
    153       IF(lwp) WRITE(numout,*) '              Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear 
    154 #endif 
    155149      ! 
    156150#if defined key_top && ! defined key_offline 
     
    206200      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    207201         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
    208 #if defined key_coupled 
    209       IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 
    210          &   CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 
    211       IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 
    212          &   CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 
    213 #endif       
     202      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
     203         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
     204      IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     205         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     206      IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     207         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
     208 
    214209      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    215210 
     
    236231      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    237232      icpt = 0 
    238       IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    239       IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    240       IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    241       IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    242       IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    243       IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    244       IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    245       IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations 
     233      IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
     234      IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
     235      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
     236      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
     237      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
     238      IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
     239      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
     240      IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
    246241      ! 
    247242      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
     
    254249      IF(lwp) THEN 
    255250         WRITE(numout,*) 
    256          IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    257          IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation' 
    258          IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation' 
    259          IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation' 
    260          IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation' 
    261          IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation' 
    262          IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation' 
    263          IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    264       ENDIF 
    265       ! 
    266                           CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    267       ! 
    268       IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    269       ! 
    270       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    271       ! 
     251         IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     252         IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
     253         IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
     254         IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
     255         IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
     256         IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
     257         IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
     258         IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
     259      ENDIF 
     260      ! 
     261                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
     262      ! 
     263      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     264      ! 
     265      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     266      ! 
     267      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
     268 
    272269   END SUBROUTINE sbc_init 
    273270 
     
    320317      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    321318      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    322       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    323       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
    324       CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    325       CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    326       CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    327       CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
    328       CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    329       CASE( -1 )                                 
    330                        CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    331                        CALL sbc_gyre    ( kt )                    ! 
    332                        CALL sbc_flx     ( kt )                    ! 
    333                        CALL sbc_blk_clio( kt )                    ! 
    334                        CALL sbc_blk_core( kt )                    ! 
    335                        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
     319      CASE( jp_gyre )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
     320      CASE( jp_ana  )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     321      CASE( jp_flx  )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
     322      CASE( jp_clio )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
     323      CASE( jp_core )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     324      CASE( jp_cpl  )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     325      CASE( jp_mfs  )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     326      CASE( jp_esopa )                                 
     327                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     328                             CALL sbc_gyre    ( kt )                    ! 
     329                             CALL sbc_flx     ( kt )                    ! 
     330                             CALL sbc_blk_clio( kt )                    ! 
     331                             CALL sbc_blk_core( kt )                    ! 
     332                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
    336333      END SELECT 
    337334 
     
    342339      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    343340      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    344       !is it useful? 
    345341      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    346342      END SELECT                                               
     
    414410         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    415411         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     412         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
     413         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    416414      ENDIF 
    417415      ! 
    418416      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at  
    419417      CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice) 
    420       CALL iom_put( "taum", taum )   ! wind stress module  
    421       CALL iom_put( "wspd", wndm )   ! wind speed  module  
    422418      ! 
    423419      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4897 r4901  
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
    12    !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
     12   !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
    1313   !!---------------------------------------------------------------------- 
    1414 
     
    1717   !!   tra_qsr_init : solar radiation penetration initialization 
    1818   !!---------------------------------------------------------------------- 
    19    USE oce            ! ocean dynamics and active tracers 
    20    USE dom_oce        ! ocean space and time domain 
    21    USE sbc_oce        ! surface boundary condition: ocean 
    22    USE trc_oce        ! share SMS/Ocean variables 
    23    USE trd_oce        ! trends: ocean variables 
    24    USE trdtra         ! trends manager: tracers  
    25    USE phycst         ! physical constants 
    26    USE sbc_ice,  ONLY : lk_lim3 
    27    ! 
    28    USE in_out_manager ! I/O manager 
    29    USE prtctl         ! Print control 
    30    USE iom            ! I/O manager 
    31    USE fldread        ! read input fields 
    32    USE lib_mpp        ! MPP library 
     19   USE oce             ! ocean dynamics and active tracers 
     20   USE dom_oce         ! ocean space and time domain 
     21   USE sbc_oce         ! surface boundary condition: ocean 
     22   USE trc_oce         ! share SMS/Ocean variables 
     23   USE trdmod_oce      ! ocean variables trends 
     24   USE trdtra          ! ocean active tracers trends  
     25   USE in_out_manager  ! I/O manager 
     26   USE phycst          ! physical constants 
     27   USE prtctl          ! Print control 
     28   USE iom             ! I/O manager 
     29   USE fldread         ! read input fields 
     30   USE restart         ! ocean restart 
     31   USE lib_mpp         ! MPP library 
    3332   USE wrk_nemo       ! Memory Allocation 
    3433   USE timing         ! Timing 
     34   USE sbc_ice, ONLY : lk_lim3 
    3535 
    3636   IMPLICIT NONE 
     
    5151   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
    5252    
    53    INTEGER , PUBLIC ::   nksr   !: levels below which the light cannot penetrate ( depth larger than 391 m) 
    54  
    55    REAL(wp)                  ::   xsi0r, xsi1r        ! inverse of rn_si0 and rn_si1, resp. 
    56    REAL(wp), DIMENSION(3,61) ::   rkrgb               ! tabulated attenuation coefficients for RGB absorption 
     53   ! Module variables 
     54   REAL(wp) ::   xsi0r                           !: inverse of rn_si0 
     55   REAL(wp) ::   xsi1r                           !: inverse of rn_si1 
    5756   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     57   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     58   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5859 
    5960   !! * Substitutions 
     
    8990      !! 
    9091      !! ** Action  : - update ta with the penetrative solar radiation trend 
    91       !!              - send the trend to trdtra (l_trdtra=T) 
     92      !!              - save the trend in ttrd ('key_trdtra') 
    9293      !! 
    9394      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    9495      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
    9596      !!---------------------------------------------------------------------- 
     97      ! 
    9698      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    9799      ! 
     
    118120      ENDIF 
    119121 
    120       IF( l_trdtra ) THEN      ! Save temperature trends 
     122      IF( l_trdtra ) THEN      ! Save ta and sa trends 
    121123         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )  
    122124         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     
    143145      !                                        Compute now qsr tracer content field 
    144146      !                                        ************************************ 
     147       
    145148      !                                           ! ============================================== ! 
    146149      IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  ! 
     
    164167               DO ji = 1, jpi 
    165168                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
    166                      oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
    167                      iatte(ji,jj) = oatte(ji,jj) 
     169                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
    168170                  ENDIF 
    169171               END DO 
     
    180182            IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume 
    181183               ! 
    182                IF( nn_chldta == 1 ) THEN                             !- Variable Chlorophyll 
     184               IF( nn_chldta == 1 ) THEN                             !* Variable Chlorophyll 
    183185                  ! 
    184186                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step 
     
    196198                     END DO 
    197199                  END DO 
    198                ELSE                                                  !- Variable ocean volume but constant chrlorophyll 
    199                   zchl = 0.05                                           ! constant chlorophyll 
     200               ELSE                                            ! Variable ocean volume but constant chrlorophyll 
     201                  zchl = 0.05                                     ! constant chlorophyll 
    200202                  irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 ) 
    201                   zekb(:,:) = rkrgb(1,irgb)                             ! Separation in R-G-B depending of the chlorophyll  
     203                  zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll  
    202204                  zekg(:,:) = rkrgb(2,irgb) 
    203205                  zekr(:,:) = rkrgb(3,irgb) 
    204206               ENDIF 
    205207               ! 
    206                zcoef  = ( 1. - rn_abs ) / 3.e0                       !- equi-partition in R-G-B 
    207                ze0(:,:,1) = rn_abs * qsr(:,:) 
    208                ze1(:,:,1) =  zcoef * qsr(:,:) 
    209                ze2(:,:,1) =  zcoef * qsr(:,:) 
    210                ze3(:,:,1) =  zcoef * qsr(:,:) 
    211                zea(:,:,1) =          qsr(:,:) 
     208               zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B 
     209               ze0(:,:,1) = rn_abs  * qsr(:,:) 
     210               ze1(:,:,1) = zcoef * qsr(:,:) 
     211               ze2(:,:,1) = zcoef * qsr(:,:) 
     212               ze3(:,:,1) = zcoef * qsr(:,:) 
     213               zea(:,:,1) =         qsr(:,:) 
    212214               ! 
    213215               DO jk = 2, nksr+1 
     
    236238                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
    237239                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
    238                         oatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
    239                         iatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) * tmask(ji,jj,2) 
     240                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
    240241                     END DO 
    241242                  END DO 
     
    254255               ! clem: store attenuation coefficient of the first ocean level 
    255256               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
    256                 
    257 !!gm  BUG ??????   ? ?  ? 
    258                   oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    259                   iatte(:,:) = oatte(:,:) 
     257                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    260258               ENDIF 
    261259           ENDIF 
     
    284282                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
    285283                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
    286                         oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
    287                         iatte(ji,jj) = oatte(ji,jj) 
     284                        fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
    288285                     END DO 
    289286                  END DO 
     
    299296               ! clem: store attenuation coefficient of the first ocean level 
    300297               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
    301                   oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    302                   iatte(:,:) = oatte(:,:) 
     298                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    303299               ENDIF 
    304300               ! 
     
    331327      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    332328         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    333          CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
     329         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 
    334330         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )  
    335331      ENDIF 
     
    362358      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    363359      !!---------------------------------------------------------------------- 
     360      ! 
    364361      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    365362      INTEGER  ::   irgb, ierror, ioptio, nqsr   ! local integer 
     
    380377      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    381378      ! 
    382       ! clem init for oatte and iatte 
     379      ! Default value for fraqsr_1lev 
    383380      IF( .NOT. ln_rstart ) THEN 
    384          oatte(:,:) = 1._wp 
    385          iatte(:,:) = 1._wp 
     381         fraqsr_1lev(:,:) = 1._wp 
    386382      ENDIF 
    387383      ! 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4897 r4901  
    732732      ! 
    733733      !                               !* Check of some namelist values 
    734       IF( nn_mxl  < 0  .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
    735       IF( nn_pdl  < 0  .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    736       IF( nn_htau < 0  .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
    737 #if ! key_coupled 
    738       IF( nn_etau == 3 )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    739 #endif 
     734      IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
     735      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
     736      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
     737      IF( nn_etau == 3 .AND. .NOT. lk_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    740738 
    741739      IF( ln_mxl0 ) THEN 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4900 r4901  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce        ! module used in the ocean time stepping module 
    44    USE sbc_oce         ! surface boundary condition: ocean 
    4544   USE cla             ! cross land advection               (tra_cla routine) 
    4645   USE domcfg          ! domain configuration               (dom_cfg routine) 
     
    6968   USE icbini          ! handle bergs, initialisation 
    7069   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    71 #if defined key_oasis3 
    7270   USE cpl_oasis3      ! OASIS3 coupling 
    73 #elif defined key_oasis4 
    74    USE cpl_oasis4      ! OASIS4 coupling (not working) 
    75 #endif 
    7671   USE c1d             ! 1D configuration 
    7772   USE step_c1d        ! Time stepping loop for the 1D configuration 
     
    197192      ! 
    198193      CALL nemo_closefile 
     194      ! 
    199195#if defined key_iomput 
    200196      CALL xios_finalize                ! end mpp communications with xios 
    201 # if defined key_oasis3 || defined key_oasis4 
    202       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    203 # endif 
     197      IF( lk_cpl ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    204198#else 
    205 # if defined key_oasis3 || defined key_oasis4 
    206       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    207 # else 
    208       IF( lk_mpp )   CALL mppstop       ! end mpp communications 
    209 # endif 
     199      IF( lk_cpl ) THEN  
     200         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     201      ELSE 
     202         IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     203      ENDIF 
    210204#endif 
    211205      ! 
     
    277271#if defined key_iomput 
    278272      IF( Agrif_Root() ) THEN 
    279 # if defined key_oasis3 || defined key_oasis4 
    280          CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    281          CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) 
    282 # else 
    283          CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    284 # endif 
     273         IF( lk_cpl ) THEN 
     274            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
     275            CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     276         ELSE 
     277            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     278         ENDIF 
    285279      ENDIF 
    286280      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    287281#else 
    288 # if defined key_oasis3 || defined key_oasis4 
    289       IF( Agrif_Root() ) THEN 
    290          CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis 
    291       ENDIF 
    292       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
    293 # else 
    294       ilocal_comm = 0 
    295       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                 ! Nodes selection (control print return in cltxt) 
    296 # endif 
     282      IF( lk_cpl ) THEN 
     283         IF( Agrif_Root() ) THEN 
     284            CALL cpl_init( ilocal_comm )                       ! nemo local communicator given by oasis 
     285         ENDIF 
     286         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     287      ELSE 
     288         ilocal_comm = 0 
     289         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     290      ENDIF 
    297291#endif 
    298292      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4896 r4901  
    5656   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
    5757 
    58    !! arrays related to penetration of solar fluxes to calculate the heat budget for sea ice 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   oatte, iatte       !: attenuation coef of the input solar flux [unitless] 
     58   !! Energy budget of the leads (open water embedded in sea ice) 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    6060 
    6161   !!---------------------------------------------------------------------- 
     
    9494      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 
    9595         ! 
    96       ALLOCATE( iatte(jpi,jpj) , oatte(jpi,jpj) , STAT=ierr(4) ) 
     96      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 
    9797         ! 
    9898      oce_alloc = MAXVAL( ierr ) 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4897 r4901  
    207207      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    208208      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    209       IF( lk_diafwb  )  CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     209      IF( .NOT. lk_cpl ) CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    210210      IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics 
    211211      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4896 r4901  
    2525   USE sbcrnf           ! surface boundary condition: runoff variables 
    2626   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step) 
    27    USE cpl_oasis3, ONLY : lk_cpl 
     27   USE sbc_oce          ! surface boundary condition: ocean 
    2828   USE sbctide          ! Tide initialisation 
    2929 
  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r4897 r4901  
    166166      !! note that we need sbc_ssm called first in sbc 
    167167      ! 
    168       IF( ln_cpl ) THEN 
    169          IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme' 
    170          ln_cpl = .FALSE. 
    171       ENDIF 
    172168      IF( ln_apr_dyn ) THEN 
    173169         IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme' 
  • branches/2014/dev_CNRS_2014/NEMOGCM/TOOLS/COMPILE/bld.cfg

    r3695 r4901  
    5151bld::excl_dep        inc::mpe_logf.h 
    5252bld::excl_dep        use::mpi 
    53 bld::excl_dep        use::mod_prism_proto 
    54 bld::excl_dep        use::mod_prism_def_partition_proto 
    55 bld::excl_dep        use::mod_prism_get_comm 
    56 bld::excl_dep        use::mod_prism_get_proto 
    57 bld::excl_dep        use::mod_prism_put_proto 
    58 bld::excl_dep        use::mod_comprism_proto 
     53bld::excl_dep        use::mod_oasis 
    5954bld::excl_dep        use::mkl_dfti 
    6055# Don't generate interface files 
  • branches/2014/dev_CNRS_2014/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg

    r3850 r4901  
    4646bld::excl_dep        inc::mpe_logf.h 
    4747bld::excl_dep        use::mpi 
    48 bld::excl_dep        use::mod_prism_proto 
    49 bld::excl_dep        use::mod_prism_def_partition_proto 
    50 bld::excl_dep        use::mod_prism_get_comm 
    51 bld::excl_dep        use::mod_prism_get_proto 
    52 bld::excl_dep        use::mod_prism_put_proto 
    53 bld::excl_dep        use::mod_comprism_proto 
     48bld::excl_dep        use::mod_oasis 
    5449bld::excl_dep        use::mkl_dfti 
    5550bld::excl_dep       use::nc4interface 
  • branches/2014/dev_CNRS_2014/NEMOGCM/TOOLS/COMPILE/bldxag.cfg

    r3695 r4901  
    4747bld::excl_dep        inc::mpe_logf.h 
    4848bld::excl_dep        use::mpi 
    49 bld::excl_dep        use::mod_prism_proto 
    50 bld::excl_dep        use::mod_prism_def_partition_proto 
    51 bld::excl_dep        use::mod_prism_get_comm 
    52 bld::excl_dep        use::mod_prism_get_proto 
    53 bld::excl_dep        use::mod_prism_put_proto 
    54 bld::excl_dep        use::mod_comprism_proto 
     49bld::excl_dep        use::mod_oasis 
    5550bld::excl_dep        use::mkl_dfti 
    5651# Don't generate interface files 
Note: See TracChangeset for help on using the changeset viewer.