Changeset 9977


Ignore:
Timestamp:
2018-07-20T10:24:45+02:00 (2 years ago)
Author:
davestorkey
Message:

UKMO/dev_r9888_proto_GO8_package branch: merge in changes from trunk to rev 9922.

Location:
NEMO/branches/UKMO/dev_r9888_proto_GO8_package
Files:
39 edited
4 copied

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/AGRIF_DEMO/EXPREF/file_def_nemo-ice.xml

    r9572 r9977  
    55============================================================================================================ 
    66=                                           output files definition                                        = 
    7 =                                            Define your own files for lim3                                = 
     7=                                      Define your own files for sea ice                                   = 
    88=                                         put the variables you want...                                    = 
    99============================================================================================================ 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-ice.xml

    r9572 r9977  
    55============================================================================================================ 
    66=                                           output files definition                                        = 
    7 =                                            Define your own files for lim3                                = 
     7=                                      Define your own files for sea ice                                   = 
    88=                                         put the variables you want...                                    = 
    99============================================================================================================ 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-pisces.xml

    r9572 r9977  
    1414 
    1515        <file id="file31" name_suffix="_bioscalar" description="pisces sms variables" > 
    16           <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field> 
    17           <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field> 
    18           <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field> 
    19           <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field> 
    20           <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field> 
    21           <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field> 
    22           <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field> 
    23           <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field> 
    24           <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field> 
    25           <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field> 
    26           <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field> 
     16          <field field_ref="tdenit"   name="tdenit"   grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field> 
     17          <field field_ref="tnfix"    name="tnfix"    grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field> 
     18          <field field_ref="tcflx"    name="tcflx"    grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field> 
     19          <field field_ref="tcflxcum" name="tcflxcum" grid_ref="grid_1point" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field> 
     20          <field field_ref="tcexp"    name="tcexp"    grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field> 
     21          <field field_ref="tintpp"   name="tintpp"   grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field> 
     22          <field field_ref="pno3tot"  name="pno3tot"  grid_ref="grid_1point" unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field> 
     23          <field field_ref="ppo4tot"  name="ppo4tot"  grid_ref="grid_1point" unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field> 
     24          <field field_ref="psiltot"  name="psiltot"  grid_ref="grid_1point" unit="umolC"  > psiltot * 1e6  </field> 
     25          <field field_ref="palktot"  name="palktot"  grid_ref="grid_1point" unit="umolC"  > palktot * 1e6  </field> 
     26          <field field_ref="pfertot"  name="pfertot"  grid_ref="grid_1point" unit="nmolFe" > pfertot * 1e9  </field> 
    2727        </file> 
    2828 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_OFF_PISCES/EXPREF/file_def_nemo.xml

    r9539 r9977  
    1919      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files --> 
    2020        <file id="file1" name_suffix="_bioscalar" description="pisces sms variables" > 
    21            <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field> 
    22            <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field> 
    23            <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field> 
    24            <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field> 
    25            <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field> 
    26            <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field> 
    27            <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field> 
    28            <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field> 
    29            <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field> 
    30            <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field> 
    31            <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field> 
     21           <field field_ref="tdenit"   name="tdenit"   grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field> 
     22           <field field_ref="tnfix"    name="tnfix"    grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field> 
     23           <field field_ref="tcflx"    name="tcflx"    grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field> 
     24           <field field_ref="tcflxcum" name="tcflxcum" grid_ref="grid_1point" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field> 
     25           <field field_ref="tcexp"    name="tcexp"    grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field> 
     26           <field field_ref="tintpp"   name="tintpp"   grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field> 
     27           <field field_ref="pno3tot"  name="pno3tot"  grid_ref="grid_1point" unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field> 
     28           <field field_ref="ppo4tot"  name="ppo4tot"  grid_ref="grid_1point" unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field> 
     29           <field field_ref="psiltot"  name="psiltot"  grid_ref="grid_1point" unit="umolC"  > psiltot * 1e6  </field> 
     30           <field field_ref="palktot"  name="palktot"  grid_ref="grid_1point" unit="umolC"  > palktot * 1e6  </field> 
     31           <field field_ref="pfertot"  name="pfertot"  grid_ref="grid_1point" unit="nmolFe" > pfertot * 1e9  </field> 
    3232        </file> 
    3333      </file_group> 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_SAS_ICE/EXPREF/file_def_nemo-ice.xml

    r9572 r9977  
    55============================================================================================================ 
    66=                                           output files definition                                        = 
    7 =                                            Define your own files for lim3                                = 
     7=                                      Define your own files for sea ice                                   = 
    88=                                         put the variables you want...                                    = 
    99============================================================================================================ 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/SHARED/field_def_nemo-oce.xml

    r9893 r9977  
    347347         <field id="uoce"         long_name="ocean current along i-axis"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" /> 
    348348         <field id="uoce_e3u"     long_name="ocean current along i-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_U_3D"  > uoce * e3u </field> 
     349         <field id="uoce2_e3u"    long_name="ocean current along i-axis squared * e3u"                                                           unit="m3/s2"      grid_ref="grid_U_3D"  > uoce * uoce * e3u </field> 
    349350         <field id="ssu"          long_name="ocean surface current along i-axis"                                                                 unit="m/s"                             /> 
    350351         <field id="sbu"          long_name="ocean bottom current along i-axis"                                                                  unit="m/s"                             /> 
     
    401402         <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" /> 
    402403         <field id="voce_e3v"     long_name="ocean current along j-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_V_3D"  > voce * e3v </field> 
     404         <field id="voce2_e3v"    long_name="ocean current along j-axis squared * e3v"                                                           unit="m3/s2"      grid_ref="grid_V_3D"  > voce * voce * e3v </field> 
    403405         <field id="ssv"          long_name="ocean surface current along j-axis"                                                                 unit="m/s"                             /> 
    404406         <field id="sbv"          long_name="ocean bottom current along j-axis"                                                                  unit="m/s"                             /> 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/SPITZ12/EXPREF/file_def_nemo-ice.xml

    r9572 r9977  
    55============================================================================================================ 
    66=                                           output files definition                                        = 
    7 =                                            Define your own files for lim3                                = 
     7=                                      Define your own files for sea ice                                   = 
    88=                                         put the variables you want...                                    = 
    99============================================================================================================ 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/SPITZ12/EXPREF/namelist_ice_cfg

    r9801 r9977  
    8686&namini         !   Ice initialization 
    8787!------------------------------------------------------------------------------ 
    88    ln_iceini        = .false.         !  activate ice initialization (T) or not (F) 
     88   ln_iceini        = .true.         !  activate ice initialization (T) or not (F) 
    8989   rn_thres_sst     =   0.5           !  max delta temp. above Tfreeze with initial ice = (sst - tfreeze) 
    9090   rn_hts_ini_n     =   0.1           !  initial real snow thickness (m), North 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/ice.F90

    r9892 r9977  
    210210   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    211211   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
    212    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur      !: net downward heat flux from the ice to the ocean 
     212   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsb_ice_bot !: net downward heat flux from the ice to the ocean 
    213213   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    214214 
     
    256256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
    257257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping                [W.m-2] 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations      [W.m-2] 
    259    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  [W.m-2] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_atm_oi   !: heat flux available for thermo transformations      [W.m-2] 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_oce_ai   !: heat flux remaining at the end of thermo transformations  [W.m-2] 
    260260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                   [kg.m-2.s-1] 
    261261    
     
    270270 
    271271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot    !: transmitted solar radiation under ice 
    273273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice         !: temperature of the first layer (Jules coupling) [K] 
    274274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice        !: effective conductivity at the top of ice/snow (Jules coupling) [W.m-2.K-1] 
     
    360360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si          !: Temperature at Snow-ice interface (K)  
    361361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si         !: mean temperature at the snow-ice interface (K)  
    362    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_fc_bo    !: Bottom conduction flux (W/m2) 
    363    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_fc_su    !: Surface conduction flux (W/m2) 
     362   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot   !: Bottom conduction flux (W/m2) 
     363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top   !: Surface conduction flux (W/m2) 
    364364 
    365365   ! 
     
    387387 
    388388      ii = ii + 1 
    389       ALLOCATE( t_bo   (jpi,jpj) , wfx_snw_sni(jpi,jpj) ,                                                & 
    390          &      wfx_snw(jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) ,  & 
    391          &      wfx_ice(jpi,jpj) , wfx_sub    (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam    (jpi,jpj) ,  & 
    392          &      wfx_pnd(jpi,jpj) ,                                                                       & 
    393          &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,              & 
    394          &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,              & 
    395          &      afx_tot(jpi,jpj) , rn_amax_2d(jpi,jpj),                                                  & 
    396          &      fhtur  (jpi,jpj) , qlead  (jpi,jpj) ,                                                    & 
    397          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
    398          &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  & 
    399          &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) ,                        &  
    400          &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld   (jpi,jpj) ,                        & 
    401          &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
    402          &      hfx_opw(jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
    403          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)        ,  STAT=ierr(ii) ) 
     389      ALLOCATE( t_bo       (jpi,jpj) , wfx_snw_sni(jpi,jpj) ,                                                & 
     390         &      wfx_snw    (jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) ,  & 
     391         &      wfx_ice    (jpi,jpj) , wfx_sub    (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam    (jpi,jpj) ,  & 
     392         &      wfx_pnd    (jpi,jpj) ,                                                                       & 
     393         &      wfx_bog    (jpi,jpj) , wfx_dyn   (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,           & 
     394         &      wfx_res    (jpi,jpj) , wfx_sni   (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,           & 
     395         &      afx_tot    (jpi,jpj) , rn_amax_2d(jpi,jpj),                                                  & 
     396         &      qsb_ice_bot(jpi,jpj) , qlead     (jpi,jpj) ,                                                 & 
     397         &      sfx_res    (jpi,jpj) , sfx_bri   (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
     398         &      sfx_bog    (jpi,jpj) , sfx_bom   (jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  & 
     399         &      hfx_res    (jpi,jpj) , hfx_snw   (jpi,jpj) , hfx_sub(jpi,jpj) ,                        &  
     400         &      qt_atm_oi  (jpi,jpj) , qt_oce_ai (jpi,jpj) , fhld   (jpi,jpj) ,                        & 
     401         &      hfx_sum    (jpi,jpj) , hfx_bom   (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
     402         &      hfx_opw    (jpi,jpj) , hfx_thd   (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
     403         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)             ,  STAT=ierr(ii) ) 
    404404 
    405405      ! * Ice global state variables 
    406406      ii = ii + 1 
    407       ALLOCATE( ftr_ice(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) ,  & 
    408          &      h_i    (jpi,jpj,jpl) , a_i    (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,  & 
    409          &      v_s    (jpi,jpj,jpl) , h_s    (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,  & 
    410          &      s_i    (jpi,jpj,jpl) , sv_i   (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,  & 
    411          &      oa_i   (jpi,jpj,jpl) , bv_i   (jpi,jpj,jpl) , STAT=ierr(ii) ) 
     407      ALLOCATE( qtr_ice_bot(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) ,  & 
     408         &      h_i        (jpi,jpj,jpl) , a_i    (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,  & 
     409         &      v_s        (jpi,jpj,jpl) , h_s    (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,  & 
     410         &      s_i        (jpi,jpj,jpl) , sv_i   (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,  & 
     411         &      oa_i       (jpi,jpj,jpl) , bv_i   (jpi,jpj,jpl) , STAT=ierr(ii) ) 
    412412 
    413413      ii = ii + 1 
     
    451451      ! * SIMIP diagnostics 
    452452      ii = ii + 1 
    453       ALLOCATE( t_si (jpi,jpj,jpl) , tm_si(jpi,jpj) , diag_fc_bo(jpi,jpj) , diag_fc_su(jpi,jpj) , STAT = ierr(ii) ) 
     453      ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    454454 
    455455      ice_alloc = MAXVAL( ierr(:) ) 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/ice1d.F90

    r9892 r9977  
    3232 
    3333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qtr_ice_bot_1d    
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d   
    3636   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d   
     
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qml_ice_1d     !: heat available for snow / ice surface melting [W/m2]  
    4141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcn_ice_1d     !: heat available for snow / ice surface sublimation [W/m2]  
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_tr_1d !: solar flux transmitted below the ice surface [W/m2]  
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qtr_ice_top_1d !: solar flux transmitted below the ice surface [W/m2]  
    4343   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t1_ice_1d      !: temperature of the 1st layer (Jules coupling) [K] 
    4444   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   cnd_ice_1d     !: conductivity at the top of ice/snow (Jules coupling) [W/K/m2] 
     
    5353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
    5454   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_out_1d 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qt_oce_ai_1d 
    5656 
    5757   ! heat flux associated with ice-atmosphere mass exchange 
     
    9393   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_dyn_1d 
    9494 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d       !: <==> the 2D  at_i 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ato_i_1d      !: <==> the 2D  ato_i 
    98    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur 
    99    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    101    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice 
    102    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice 
    103  
    104    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su 
    105    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_si_1d       !: <==> the 2D  t_si 
    106    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i 
    107    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ib_1d       !: <==> the 2D  a_i_b 
    108    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_i_1d        !: 
    109    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ib_1d       !: 
    110    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_s_1d        !: 
    111    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux  
    112    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux  
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ato_i_1d 
     98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsb_ice_bot_1d 
     99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d 
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d 
     103 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_si_1d 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ib_1d 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_i_1d 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ib_1d 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_s_1d 
    113111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m] 
    114112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sum      !: Ice surface ablation [m] 
     
    140138 
    141139   ! Conduction flux diagnostics (SIMIP) 
    142    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   diag_fc_bo_1d      !: <==> the 2D  diag_fc_bo 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   diag_fc_su_1d      !: <==> the 2D  diag_fc_su 
     140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcn_ice_bot_1d 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcn_ice_top_1d 
    144142 
    145143   ! surface fields from the ocean 
     
    182180      ii = 1 
    183181      ALLOCATE( nptidx    (jpij) ,   & 
    184          &      qlead_1d  (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d(jpij) ,   & 
    185          &      qns_ice_1d(jpij) , qml_ice_1d(jpij) , qcn_ice_1d(jpij) , qsr_ice_tr_1d(jpij) , & 
    186          &      cnd_ice_1d(jpij) , t1_ice_1d (jpij) , t_bo_1d   (jpij) ,   & 
    187          &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) , hfx_bog_1d(jpij) ,   &  
    188          &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) , hfx_dyn_1d(jpij) ,   & 
    189          &      rn_amax_1d(jpij) ,                                         & 
    190          &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      & 
    191          &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) ,                      & 
    192          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , hfx_out_1d(jpij), STAT=ierr(ii) ) 
     182         &      qlead_1d  (jpij) , qtr_ice_bot_1d(jpij) , qsr_ice_1d(jpij) ,   & 
     183         &      qns_ice_1d(jpij) , qml_ice_1d    (jpij) , qcn_ice_1d(jpij) , qtr_ice_top_1d(jpij) , & 
     184         &      cnd_ice_1d(jpij) , t1_ice_1d     (jpij) , t_bo_1d   (jpij) ,   & 
     185         &      hfx_sum_1d(jpij) , hfx_bom_1d    (jpij) , hfx_bog_1d(jpij) ,   &  
     186         &      hfx_dif_1d(jpij) , hfx_opw_1d    (jpij) , hfx_dyn_1d(jpij) ,   & 
     187         &      rn_amax_1d(jpij) ,                                             & 
     188         &      hfx_thd_1d(jpij) , hfx_spr_1d    (jpij) ,                      & 
     189         &      hfx_snw_1d(jpij) , hfx_sub_1d    (jpij) ,                      & 
     190         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
    193191      ! 
    194192      ii = ii + 1 
    195193      ALLOCATE( sprecip_1d    (jpij) , at_i_1d       (jpij) , ato_i_1d      (jpij) ,                         & 
    196          &      fhtur_1d      (jpij) , wfx_snw_sni_1d(jpij) , wfx_spr_1d    (jpij) , wfx_snw_sum_1d(jpij) ,  & 
     194         &      qsb_ice_bot_1d(jpij) , wfx_snw_sni_1d(jpij) , wfx_spr_1d    (jpij) , wfx_snw_sum_1d(jpij) ,  & 
    197195         &      fhld_1d       (jpij) , wfx_sub_1d    (jpij) , wfx_bog_1d    (jpij) , wfx_bom_1d    (jpij) ,  & 
    198196         &      wfx_sum_1d    (jpij) , wfx_sni_1d    (jpij) , wfx_opw_1d    (jpij) , wfx_res_1d    (jpij) ,  & 
     
    206204      ii = ii + 1 
    207205      ALLOCATE( t_su_1d (jpij) , t_si_1d (jpij) , a_i_1d    (jpij) , a_ib_1d (jpij) ,                   & 
    208          &      h_i_1d  (jpij) , h_ib_1d (jpij) , h_s_1d    (jpij) , fc_su   (jpij) , fc_bo_i (jpij) ,  &     
     206         &      h_i_1d  (jpij) , h_ib_1d (jpij) , h_s_1d    (jpij) ,                                    &     
    209207         &      dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm  (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) ,  &     
    210208         &      dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , s_i_1d  (jpij) , s_i_new (jpij) ,  & 
     
    219217      ! 
    220218      ii = ii + 1 
    221       ALLOCATE( diag_fc_bo_1d(jpij)      , diag_fc_su_1d(jpij)      , STAT=ierr(ii) ) 
     219      ALLOCATE( qcn_ice_bot_1d(jpij) , qcn_ice_top_1d(jpij) , STAT=ierr(ii) ) 
    222220      ! 
    223221      ii = ii + 1 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icealb.F90

    r9892 r9977  
    1616   USE ice, ONLY: jpl ! sea-ice: number of categories 
    1717   USE phycst         ! physical constants 
     18   USE dom_oce        ! domain: ocean 
    1819   ! 
    1920   USE in_out_manager ! I/O manager 
     
    160161               ENDIF 
    161162               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    162                palb_os(ji,jj,jl) = zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice 
     163               palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     164               ! 
     165               palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  & 
     166                  &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  & 
     167                  &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 
    163168               ! 
    164169            END DO 
     
    166171      END DO 
    167172      ! 
    168       palb_cs(:,:,:) = palb_os(:,:,:) - ( - 0.1010 * palb_os(:,:,:) * palb_os(:,:,:) + 0.1933 * palb_os(:,:,:) - 0.0148 ) 
    169173      ! 
    170174      IF( ln_timing )   CALL timing_stop('icealb') 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icectl.F90

    r9892 r9977  
    189189 
    190190      ! heat flux 
    191       zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   & 
     191      zhfx  = glob_sum( ( qt_atm_oi - qt_oce_ai - diag_heat - diag_trp_ei - diag_trp_es   & 
    192192      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check) 
    193193         &              ) * e1e2t ) * zconv 
     
    572572               WRITE(numout,*) 
    573573               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 
    574                WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
    575                WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
     574               WRITE(numout,*) ' qt_atm_oi    : ', qt_atm_oi(ji,jj) 
     575               WRITE(numout,*) ' qt_oce_ai    : ', qt_oce_ai(ji,jj) 
    576576               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)               
    577577               WRITE(numout,*) 
     
    579579               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
    580580               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
    581                WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
     581               WRITE(numout,*) ' qsb_ice_bot  : ', qsb_ice_bot(ji,jj)  
    582582               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
    583583               WRITE(numout,*) 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icedia.F90

    r9892 r9977  
    9595      ! 2 - Trends due to forcing  ! 
    9696      ! ---------------------------! 
    97       z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9  ! freshwater flux ice/snow-ocean  
    98       z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9                     ! freshwater flux ice/snow-atm 
    99       z_frc_sal    = r1_rau0 * glob_sum(   - sfx(:,:) * e1e2t(:,:) ) * 1.e-9                                          ! salt fluxes ice/snow-ocean 
    100       z_frc_tembot =           glob_sum( hfx_out(:,:) * e1e2t(:,:) ) * 1.e-20                                         ! heat on top of ocean (and below ice) 
    101       z_frc_temtop =           glob_sum( hfx_in (:,:) * e1e2t(:,:) ) * 1.e-20                                         ! heat on top of ice-coean 
     97      z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean  
     98      z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm 
     99      z_frc_sal    = r1_rau0 * glob_sum( -       sfx(:,:)                                     * e1e2t(:,:) ) * 1.e-9   ! salt fluxes ice/snow-ocean 
     100      z_frc_tembot =           glob_sum(   qt_oce_ai(:,:)                                     * e1e2t(:,:) ) * 1.e-20  ! heat on top of ocean (and below ice) 
     101      z_frc_temtop =           glob_sum(   qt_atm_oi(:,:)                                     * e1e2t(:,:) ) * 1.e-20  ! heat on top of ice-coean 
    102102      ! 
    103103      frc_voltop  = frc_voltop  + z_frc_voltop  * rdt_ice ! km3 
     
    110110      ! 3 -  Content variations ! 
    111111      ! ----------------------- ! 
    112       zdiff_vol = r1_rau0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3)  
    113       zdiff_sal = r1_rau0 * glob_sum( ( rhoic* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 
    114       zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:)             - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 
     112      zdiff_vol = r1_rau0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3)  
     113      zdiff_sal = r1_rau0 * glob_sum( ( rhoic* SUM( sv_i(:,:,:), dim=3 )  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9  ! salt content trend (km3*pss) 
     114      zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:)             - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J) 
    115115      !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
    116116 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icestp.F90

    r9892 r9977  
    189189         IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics       
    190190         ! 
    191          ! 
    192191         IF( ln_icethd )                CALL ice_cor( kt , 2 )        ! -- Corrections 
    193192         ! 
     
    427426 
    428427      ! SIMIP diagnostics 
    429       diag_fc_bo(:,:) = 0._wp ; diag_fc_su(:,:) = 0._wp 
    430       t_si(:,:,:) = rt0       ! temp at the ice-snow interface 
     428      qcn_ice_bot(:,:,:) = 0._wp ; qcn_ice_top(:,:,:) = 0._wp ! conductive fluxes 
     429      t_si       (:,:,:) = rt0   ! temp at the ice-snow interface 
    431430 
    432431      tau_icebfr(:,:)   = 0._wp   ! landfast ice param only (clem: important to keep the init here) 
    433       cnd_ice   (:,:,:) = 0._wp   ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling) 
     432      cnd_ice   (:,:,:) = 0._wp   ! initialisation: effective conductivity at the top of ice/snow (Jules coupling) 
     433      qtr_ice_bot(:,:,:) = 0._wp  ! initialization: part of solar radiation transmitted through the ice needed at least for outputs 
    434434      ! 
    435435      ! for control checks (ln_icediachk) 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd.F90

    r9892 r9977  
    2020   USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl 
    2121   USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, & 
    22       &                 qml_ice, qcn_ice, qsr_ice_tr 
     22      &                 qml_ice, qcn_ice, qtr_ice_top 
    2323   USE ice1D          ! sea-ice: thermodynamics variables 
    2424   USE icethd_zdf     ! sea-ice: vertical heat diffusion 
     
    128128      CALL lbc_lnk( zfric, 'T',  1. ) 
    129129      ! 
    130       ftr_ice(:,:,:) = 0._wp  ! initialization (part of solar radiation transmitted through the ice) 
    131  
    132130      !--------------------------------------------------------------------! 
    133131      ! Partial computation of forcing for the thermodynamic sea ice model 
     
    143141            !           !  temperature and turbulent mixing (McPhee, 1992) 
    144142            ! 
    145             ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
     143            ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
    146144            zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    147145               &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
    148146               &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    149147 
    150             ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    151             ! includes supercooling potential energy (>0) or "above-freezing" energy (<0) 
    152             zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    153  
    154             ! --- Above-freezing sensible heat content (J/m2 grid) 
    155             zqfr_neg = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp ) 
    156  
    157             ! --- Sensible ocean-to-ice heat flux (W/m2) 
    158             zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    159             fhtur(ji,jj) = rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
    160  
    161             fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    162             ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
    163             !                        the freezing point, so that we do not have SST < T_freeze 
    164             !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    165  
    166             !-- Energy Budget of the leads (J.m-2), source of lateral accretion. Must be < 0 to form ice 
    167             qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
     148            ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 
     149            zqfr     = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 
     150            zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
     151 
     152            ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 
     153            zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
     154            qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
     155 
     156            qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     157            ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     158            !                              the freezing point, so that we do not have SST < T_freeze 
     159            !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
     160 
     161            !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 
     162            qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    168163 
    169164            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     
    177172            ! Net heat flux on top of the ice-ocean [W.m-2] 
    178173            ! --------------------------------------------- 
    179             hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
     174            qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    180175         END DO 
    181176      END DO 
     
    185180      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 
    186181      IF( .NOT. ln_icedH ) THEN 
    187          hfx_in(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
    188          fhtur (:,:) = 0._wp 
    189          fhld  (:,:) = 0._wp 
     182         qt_atm_oi  (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     183         qsb_ice_bot(:,:) = 0._wp 
     184         fhld       (:,:) = 0._wp 
    190185      ENDIF 
    191186 
     
    193188      ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    194189      ! --------------------------------------------------------------------- 
    195       !     First  step here              :  non solar + precip - qlead - qturb 
     190      !     First  step here              :  non solar + precip - qlead - qsensible 
    196191      !     Second step in icethd_dh      :  heat remaining if total melt (zq_rema)  
    197192      !     Third  step in iceupdate.F90  :  heat from ice-ocean mass exchange (zf_mass) + solar 
    198       hfx_out(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)  &  ! Non solar heat flux received by the ocean                
    199          &           - qlead(:,:) * r1_rdtice                                &  ! heat flux taken from the ocean where there is open water ice formation 
    200          &           - at_i (:,:) * fhtur(:,:)                               &  ! heat flux taken by turbulence 
    201          &           - at_i (:,:) *  fhld(:,:)                                  ! heat flux taken during bottom growth/melt  
    202                                                                                 !    (fhld should be 0 while bott growth) 
     193      qt_oce_ai(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)  &  ! Non solar heat flux received by the ocean                
     194         &             - qlead(:,:) * r1_rdtice                                &  ! heat flux taken from the ocean where there is open water ice formation 
     195         &             - at_i (:,:) * qsb_ice_bot(:,:)                         &  ! heat flux taken by sensible flux 
     196         &             - at_i (:,:) * fhld       (:,:)                            ! heat flux taken during bottom growth/melt  
     197      !                                                                           !    (fhld should be 0 while bott growth) 
    203198      !-------------------------------------------------------------------------------------------! 
    204199      ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories 
     
    377372         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
    378373         ! 
    379          CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d(1:npti), qprec_ice        ) 
    380          CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d  (1:npti), qsr_ice (:,:,kl) ) 
    381          CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d  (1:npti), qns_ice (:,:,kl) ) 
    382          CALL tab_2d_1d( npti, nptidx(1:npti), ftr_ice_1d  (1:npti), ftr_ice (:,:,kl) ) 
    383          CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d (1:npti), evap_ice(:,:,kl) ) 
    384          CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) ) 
    385          CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d     (1:npti), t_bo             ) 
    386          CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d  (1:npti), sprecip          )  
    387          CALL tab_2d_1d( npti, nptidx(1:npti), fhtur_1d    (1:npti), fhtur            ) 
    388          CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d     (1:npti), fhld             ) 
     374         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
     375         CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d    (1:npti), qsr_ice (:,:,kl)     ) 
     376         CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d    (1:npti), qns_ice (:,:,kl)     ) 
     377         CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d   (1:npti), evap_ice(:,:,kl)     ) 
     378         CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d   (1:npti), dqns_ice(:,:,kl)     ) 
     379         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d       (1:npti), t_bo                 ) 
     380         CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d    (1:npti), sprecip              )  
     381         CALL tab_2d_1d( npti, nptidx(1:npti), qsb_ice_bot_1d(1:npti), qsb_ice_bot          ) 
     382         CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d       (1:npti), fhld                 ) 
    389383          
    390          CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d   (1:npti), qml_ice      (:,:,kl) ) 
    391          CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d   (1:npti), qcn_ice      (:,:,kl) ) 
    392          CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_tr_1d(1:npti), qsr_ice_tr   (:,:,kl) ) 
     384         CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d    (1:npti), qml_ice    (:,:,kl) ) 
     385         CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d    (1:npti), qcn_ice    (:,:,kl) ) 
     386         CALL tab_2d_1d( npti, nptidx(1:npti), qtr_ice_top_1d(1:npti), qtr_ice_top(:,:,kl) ) 
    393387         ! 
    394388         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni   ) 
     
    417411         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam          ) 
    418412         ! 
    419          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd          ) 
    420          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr          ) 
    421          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum          ) 
    422          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom          ) 
    423          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog          ) 
    424          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif          ) 
    425          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw          ) 
    426          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw          ) 
    427          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub          ) 
    428          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res          ) 
     413         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d    (1:npti), hfx_thd       ) 
     414         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d    (1:npti), hfx_spr       ) 
     415         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d    (1:npti), hfx_sum       ) 
     416         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d    (1:npti), hfx_bom       ) 
     417         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d    (1:npti), hfx_bog       ) 
     418         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d    (1:npti), hfx_dif       ) 
     419         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d    (1:npti), hfx_opw       ) 
     420         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d    (1:npti), hfx_snw       ) 
     421         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d    (1:npti), hfx_sub       ) 
     422         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res       ) 
    429423         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif   ) 
    430424         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem   ) 
    431          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out          ) 
    432          ! 
    433          ! SIMIP diagnostics 
    434          CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo   ) 
    435          CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su   ) 
     425         CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai     ) 
     426         ! 
    436427         ! ocean surface fields 
    437428         CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m ) 
     
    507498         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam        ) 
    508499         ! 
    509          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd        ) 
    510          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr        ) 
    511          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum        ) 
    512          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom        ) 
    513          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog        ) 
    514          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif        ) 
    515          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw        ) 
    516          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw        ) 
    517          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub        ) 
    518          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res        ) 
     500         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d    (1:npti), hfx_thd     ) 
     501         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_spr_1d    (1:npti), hfx_spr     ) 
     502         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sum_1d    (1:npti), hfx_sum     ) 
     503         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bom_1d    (1:npti), hfx_bom     ) 
     504         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bog_1d    (1:npti), hfx_bog     ) 
     505         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_dif_1d    (1:npti), hfx_dif     ) 
     506         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d    (1:npti), hfx_opw     ) 
     507         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_snw_1d    (1:npti), hfx_snw     ) 
     508         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sub_1d    (1:npti), hfx_sub     ) 
     509         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res     ) 
    519510         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 
    520511         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem ) 
    521          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out        ) 
    522          ! 
    523          CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d(1:npti), qns_ice(:,:,kl) ) 
    524          CALL tab_1d_2d( npti, nptidx(1:npti), ftr_ice_1d(1:npti), ftr_ice(:,:,kl) ) 
     512         CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai   ) 
     513         ! 
     514         CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d    (1:npti), qns_ice    (:,:,kl) ) 
     515         CALL tab_1d_2d( npti, nptidx(1:npti), qtr_ice_bot_1d(1:npti), qtr_ice_bot(:,:,kl) ) 
    525516         ! effective conductivity and 1st layer temperature (for Jules coupling) 
    526517         CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) ) 
    527518         CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) ) 
    528519         ! SIMIP diagnostics          
    529          CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d      (1:npti), t_si(:,:,kl) ) 
    530          CALL tab_1d_2d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo  ) 
    531          CALL tab_1d_2d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su  ) 
     520         CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d       (1:npti), t_si       (:,:,kl) ) 
     521         CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) 
     522         CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_top_1d(1:npti), qcn_ice_top(:,:,kl) ) 
    532523         ! extensive variables 
    533524         CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i (:,:,kl) ) 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_dh.F90

    r9892 r9977  
    8585 
    8686      REAL(wp), DIMENSION(jpij) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
    87       REAL(wp), DIMENSION(jpij) ::   zq_su       ! heat for surface ablation                   (J.m-2) 
    88       REAL(wp), DIMENSION(jpij) ::   zq_bo       ! heat for bottom ablation                    (J.m-2) 
     87      REAL(wp), DIMENSION(jpij) ::   zq_top      ! heat for surface ablation                   (J.m-2) 
     88      REAL(wp), DIMENSION(jpij) ::   zq_bot      ! heat for bottom ablation                    (J.m-2) 
    8989      REAL(wp), DIMENSION(jpij) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
    9090      REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
     
    131131         ! 
    132132         DO ji = 1, npti 
    133             zq_su(ji)      = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
     133            zq_top(ji)     = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
    134134         END DO 
    135135         ! 
    136       CASE( np_jules_EMULE ) 
     136      CASE( np_jules_OFF , np_jules_EMULE ) 
    137137         ! 
    138138         DO ji = 1, npti 
    139             zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji) 
     139            zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qtr_ice_top_1d(ji) - qcn_ice_top_1d(ji) 
    140140            qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    141             zq_su(ji)      = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
    142          END DO 
    143          ! 
    144       CASE( np_jules_OFF )  
    145          ! 
    146          DO ji = 1, npti 
    147             zdum           = qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji)  
    148             qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    149             zq_su(ji)      = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
     141            zq_top(ji)     = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 
    150142         END DO 
    151143         ! 
     
    153145      ! 
    154146      DO ji = 1, npti 
    155          zf_tt(ji)         = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    156          zq_bo(ji)         = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
     147         zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji)  
     148         zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
    157149      END DO 
    158150 
     
    210202            ! --- melt of falling snow --- 
    211203            rswitch              = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 
    212             zdeltah       (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )   ! thickness change 
    213             zdeltah       (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) )                ! bound melting  
     204            zdeltah       (ji,1) = - rswitch * zq_top(ji) / MAX( zqprec(ji) , epsi20 )   ! thickness change 
     205            zdeltah       (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) )                 ! bound melting  
    214206            hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_rdtice   ! heat used to melt snow (W.m-2, >0) 
    215207            wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhosn         * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice   ! snow melting only = water into the ocean (then without snow precip), >0 
     
    217209            ! updates available heat + precipitations after melting 
    218210            dh_s_mlt (ji) = dh_s_mlt(ji) + zdeltah(ji,1) 
    219             zq_su    (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )       
     211            zq_top   (ji) = MAX( 0._wp , zq_top (ji) + zdeltah(ji,1) * zqprec(ji) )       
    220212            zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
    221213             
     
    240232      ! Snow melting 
    241233      ! ------------ 
    242       ! If heat still available (zq_su > 0), then melt more snow 
     234      ! If heat still available (zq_top > 0), then melt more snow 
    243235      zdeltah(1:npti,:) = 0._wp 
    244236      zdh_s_mel(1:npti) = 0._wp 
    245237      DO jk = 1, nlay_s 
    246238         DO ji = 1, npti 
    247             IF( zh_s(ji,jk) > 0._wp .AND. zq_su(ji) > 0._wp ) THEN 
     239            IF( zh_s(ji,jk) > 0._wp .AND. zq_top(ji) > 0._wp ) THEN 
    248240               ! 
    249241               rswitch          = MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,jk) - epsi20 ) ) 
    250                zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( e_s_1d(ji,jk), epsi20 )   ! thickness change 
    251                zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) )                  ! bound melting 
     242               zdeltah  (ji,jk) = - rswitch * zq_top(ji) / MAX( e_s_1d(ji,jk), epsi20 )   ! thickness change 
     243               zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) )                   ! bound melting 
    252244               zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk) 
    253245                
     
    257249               ! updates available heat + thickness 
    258250               dh_s_mlt(ji)    = dh_s_mlt(ji) + zdeltah(ji,jk) 
    259                zq_su   (ji)    = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) ) 
     251               zq_top  (ji)    = MAX( 0._wp , zq_top(ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) ) 
    260252               h_s_1d  (ji)    = MAX( 0._wp , h_s_1d(ji) + zdeltah(ji,jk) ) 
    261253               zh_s    (ji,jk) = MAX( 0._wp , zh_s(ji,jk) + zdeltah(ji,jk) ) 
     
    349341               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
    350342                
    351                zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
     343               zfmdt          = - zq_top(ji) / zdE                    ! Mass flux to the ocean [kg/m2, >0] 
    352344                
    353345               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0] 
     
    355347               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
    356348                
    357                zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
     349               zq_top(ji)      = MAX( 0._wp , zq_top(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
    358350                
    359351               dh_i_sum(ji)   = dh_i_sum(ji) + zdeltah(ji,jk)         ! Cumulate surface melt 
     
    416408      !------------------ 
    417409      ! Basal growth is driven by heat imbalance at the ice-ocean interface, 
    418       ! between the inner conductive flux  (fc_bo_i), from the open water heat flux  
    419       ! (fhld) and the turbulent ocean flux (fhtur).  
    420       ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice  
     410      ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux  
     411      ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot).  
     412      ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice  
    421413 
    422414      ! If salinity varies in time, an iterative procedure is required, because 
     
    515507                  zdE             = zEi - zEw                                                 ! Specific enthalpy difference   (J/kg, <0) 
    516508 
    517                   zfmdt           = - zq_bo(ji) / zdE                                         ! Mass flux x time step (kg/m2, >0) 
     509                  zfmdt           = - zq_bot(ji) / zdE                                        ! Mass flux x time step (kg/m2, >0) 
    518510 
    519511                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic                                        ! Gross thickness change 
     
    521513                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) )       ! bound thickness change 
    522514                   
    523                   zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE )   ! update available heat. MAX is necessary for roundup errors 
    524  
    525                   dh_i_bom(ji)    = dh_i_bom(ji) + zdeltah(ji,jk)                            ! Update basal melt 
     515                  zq_bot(ji)      = MAX( 0._wp , zq_bot(ji) - zdeltah(ji,jk) * rhoic * zdE )  ! update available heat. MAX is necessary for roundup errors 
     516 
     517                  dh_i_bom(ji)    = dh_i_bom(ji) + zdeltah(ji,jk)                             ! Update basal melt 
    526518 
    527519                  zfmdt           = - zdeltah(ji,jk) * rhoic                                  ! Mass flux x time step > 0 
     
    556548      zdeltah(1:npti,:) = 0._wp ! important 
    557549      DO ji = 1, npti 
    558          zq_rema (ji)   = zq_su(ji) + zq_bo(ji)  
     550         zq_rema (ji)   = zq_top(ji) + zq_bot(ji)  
    559551         rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) )   ! =1 if snow 
    560552         rswitch        = rswitch * MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,1) - epsi20 ) ) 
     
    570562         !     
    571563         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
    572          hfx_out_1d(ji) = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
     564         qt_oce_ai_1d(ji) = qt_oce_ai_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
    573565 
    574566         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_zdf_bl99.F90

    r9892 r9977  
    178178      !------------- 
    179179      ! --- Transmission/absorption of solar radiation in the ice --- ! 
    180       zradtr_s(1:npti,0) = qsr_ice_tr_1d(1:npti) 
     180      zradtr_s(1:npti,0) = qtr_ice_top_1d(1:npti) 
    181181      DO jk = 1, nlay_s 
    182182         DO ji = 1, npti 
     
    188188      END DO 
    189189      ! 
    190       zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qsr_ice_tr_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 
     190      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 
    191191      DO jk = 1, nlay_i  
    192192         DO ji = 1, npti 
     
    198198      END DO 
    199199      ! 
    200       ftr_ice_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice 
     200      qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice 
    201201      ! 
    202202      iconv    = 0          ! number of iterations 
     
    330330 
    331331            DO ji = 1, npti 
    332                zfnet(ji) = qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar 
     332               zfnet(ji) = qsr_ice_1d(ji) - qtr_ice_top_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar 
    333333            END DO 
    334334            ! 
     
    728728      !----------------------------- 
    729729      ! 
    730       ! --- update conduction fluxes 
    731       ! 
     730      ! --- calculate conduction fluxes (positive downward) 
     731 
    732732      DO ji = 1, npti 
    733733         !                                ! surface ice conduction flux 
    734          fc_su(ji)   =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  & 
    735             &           - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
     734         qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0)      * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )  & 
     735            &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0)      * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
    736736         !                                ! bottom ice conduction flux 
    737          fc_bo_i(ji) =  - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji) - t_i_1d(ji,nlay_i) ) 
     737         qcn_ice_bot_1d(ji) =                          - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
    738738      END DO 
    739739       
     
    750750         ! 
    751751         DO ji = 1, npti 
    752             hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( fc_su(ji)      - qcn_ice_1d(ji) ) * a_i_1d(ji)  
     752            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qcn_ice_top_1d(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji)  
    753753         END DO 
    754754         ! 
     
    770770                
    771771               IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
    772                   zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji)    - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 
     772                  zhfx_err = ( qns_ice_1d(ji)     + qsr_ice_1d(ji)     - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  & 
     773                     &       + zdq * r1_rdtice ) * a_i_1d(ji) 
    773774               ELSE                          ! case T_su = 0degC 
    774                   zhfx_err = ( fc_su(ji)      + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 
     775                  zhfx_err = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  & 
     776                     &       + zdq * r1_rdtice ) * a_i_1d(ji) 
    775777               ENDIF 
    776778                
    777779            ELSEIF( k_jules == np_jules_ACTIVE ) THEN 
    778780             
    779                zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji) 
     781               zhfx_err    = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  & 
     782                  &          + zdq * r1_rdtice ) * a_i_1d(ji) 
    780783             
    781784            ENDIF 
     
    787790            hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji) 
    788791            ! 
    789          END DO 
    790          ! 
    791          ! --- SIMIP diagnostics 
    792          ! 
    793          DO ji = 1, npti 
    794             !--- Conduction fluxes (positive downwards) 
    795             diag_fc_bo_1d(ji) = diag_fc_bo_1d(ji) + fc_bo_i(ji) * a_i_1d(ji) / at_i_1d(ji) 
    796             diag_fc_su_1d(ji) = diag_fc_su_1d(ji) + fc_su  (ji) * a_i_1d(ji) / at_i_1d(ji) 
    797     
    798             !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
    799             zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) 
    800             IF( h_s_1d(ji) >= zhs_min ) THEN 
    801                t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   & 
    802                   &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac ) 
    803             ELSE 
    804                t_si_1d(ji) = t_su_1d(ji) 
    805             ENDIF 
    806792         END DO 
    807793         ! 
     
    827813      IF( k_jules == np_jules_EMULE ) THEN 
    828814         ! Restore temperatures to their initial values 
    829          t_s_1d    (1:npti,:) = ztsold(1:npti,:) 
    830          t_i_1d    (1:npti,:) = ztiold(1:npti,:) 
    831          qcn_ice_1d(1:npti)   = fc_su (1:npti) 
     815         t_s_1d    (1:npti,:) = ztsold        (1:npti,:) 
     816         t_i_1d    (1:npti,:) = ztiold        (1:npti,:) 
     817         qcn_ice_1d(1:npti)   = qcn_ice_top_1d(1:npti) 
    832818      ENDIF 
    833819      ! 
     820      ! --- SIMIP diagnostics 
     821      ! 
     822      DO ji = 1, npti          
     823         !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
     824         zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) 
     825         IF( h_s_1d(ji) >= zhs_min ) THEN 
     826            t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   & 
     827               &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac ) 
     828         ELSE 
     829            t_si_1d(ji) = t_su_1d(ji) 
     830         ENDIF 
     831      END DO 
     832      ! 
    834833   END SUBROUTINE ice_thd_zdf_BL99 
    835  
    836834 
    837835#else 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/iceupdate.F90

    r9892 r9977  
    107107      ! --- case we bypass ice thermodynamics --- ! 
    108108      IF( .NOT. ln_icethd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
    109          hfx_in   (:,:)   = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
    110          hfx_out  (:,:)   = ( 1._wp - at_i_b(:,:) ) *   qns_oce(:,:)                  + qemp_oce(:,:) 
    111          ftr_ice  (:,:,:) = 0._wp 
    112          emp_ice  (:,:)   = 0._wp 
    113          qemp_ice (:,:)   = 0._wp 
    114          qevap_ice(:,:,:) = 0._wp 
     109         qt_atm_oi  (:,:)   = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     110         qt_oce_ai  (:,:)   = ( 1._wp - at_i_b(:,:) ) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     111         emp_ice    (:,:)   = 0._wp 
     112         qemp_ice   (:,:)   = 0._wp 
     113         qevap_ice  (:,:,:) = 0._wp 
    115114      ENDIF 
    116115       
     
    120119            ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    121120            !--------------------------------------------------- 
    122             zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - ftr_ice(ji,jj,:) ) ) 
    123  
    124             ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     121            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
     122 
     123            ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)  
    125124            !--------------------------------------------------- 
    126             zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
    127             hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 
     125            zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     126            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 
    128127 
    129128            ! Add the residual from heat diffusion equation and sublimation (W.m-2) 
    130129            !---------------------------------------------------------------------- 
    131             hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   & 
    132                &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
     130            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   & 
     131               &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
    133132 
    134133            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    135134            !---------------------------------------------------------------------------- 
    136135            qsr(ji,jj) = zqsr                                       
    137             qns(ji,jj) = hfx_out(ji,jj) - zqsr               
     136            qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr               
    138137 
    139138            ! Mass flux at the atm. surface        
     
    250249      IF( iom_use('qsr_ice'    ) )   CALL iom_put( "qsr_ice"    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface 
    251250      IF( iom_use('qns_ice'    ) )   CALL iom_put( "qns_ice"    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface 
    252       IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( ftr_ice * a_i_b, dim=3 )                              )   !     solar flux transmitted thru ice 
    253       IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qsr_ice_tr * a_i_b, dim=3 )                           )   !     solar flux transmitted thru ice surface 
     251      IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice 
     252      IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface 
    254253      IF( iom_use('qt_oce'     ) )   CALL iom_put( "qt_oce"     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
    255254      IF( iom_use('qt_ice'     ) )   CALL iom_put( "qt_ice"     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
    256       IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( "qt_oce_ai"  , hfx_out * tmask(:,:,1)                                     )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
    257       IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( "qt_atm_oi"  , hfx_in * tmask(:,:,1)                                      )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
     255      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( "qt_oce_ai"  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
     256      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( "qt_atm_oi"  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
    258257      IF( iom_use('qemp_oce'   ) )   CALL iom_put( "qemp_oce"   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean 
    259258      IF( iom_use('qemp_ice'   ) )   CALL iom_put( "qemp_ice"   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice 
     
    267266      IF( iom_use('hfxdif'     ) )   CALL iom_put ("hfxdif"     , hfx_dif             )   ! heat flux used for ice temperature change 
    268267      IF( iom_use('hfxsnw'     ) )   CALL iom_put ("hfxsnw"     , hfx_snw             )   ! heat flux used for snow melt  
    269       IF( iom_use('hfxerr'     ) )   CALL iom_put ("hfxerr"     , hfx_err_dif         )   ! heat flux error after heat diffusion (included in hfx_out) 
     268      IF( iom_use('hfxerr'     ) )   CALL iom_put ("hfxerr"     , hfx_err_dif         )   ! heat flux error after heat diffusion (included in qt_oce_ai) 
    270269 
    271270      ! heat fluxes associated with mass exchange (freeze/melt/precip...) 
     
    277276 
    278277      ! other heat fluxes 
    279       IF( iom_use('hfxsensib'  ) )   CALL iom_put( "hfxsensib"  , -fhtur     * at_i_b )   ! Sensible oceanic heat flux 
    280       IF( iom_use('hfxcndbot'  ) )   CALL iom_put( "hfxcndbot"  , diag_fc_bo * at_i_b )   ! Bottom conduction flux 
    281       IF( iom_use('hfxcndtop'  ) )   CALL iom_put( "hfxcndtop"  , diag_fc_su * at_i_b )   ! Surface conduction flux 
     278      IF( iom_use('hfxsensib'  ) )   CALL iom_put( "hfxsensib"  ,     -qsb_ice_bot * at_i_b        )   ! Sensible oceanic heat flux 
     279      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( "hfxcndbot"  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
     280      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( "hfxcndtop"  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
    282281 
    283282      ! diags 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/BDY/bdydta.F90

    r9892 r9977  
    351351               ENDIF 
    352352#if defined key_si3 
     353               ! convert N-cat fields (input) into jpl-cat (output) 
    353354               IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 
    354355                  jfld_hti = jfld_htit(jbdy) 
    355356                  jfld_hts = jfld_htst(jbdy) 
    356357                  jfld_ai  = jfld_ait(jbdy) 
    357                   IF( nice_cat == 1 ) THEN ! case input cat = 1 
     358                  IF    ( jpl /= 1 .AND. nice_cat == 1 ) THEN                      ! case input cat = 1 
    358359                     CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 
    359360                        &               dta_bdy(jbdy)%h_i     , dta_bdy(jbdy)%h_s     , dta_bdy(jbdy)%a_i    ) 
    360                   ELSEIF( nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 
     361                  ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 
    361362                     CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 
    362363                        &               dta_bdy(jbdy)%h_i     , dta_bdy(jbdy)%h_s     , dta_bdy(jbdy)%a_i    ) 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/BDY/bdyice.F90

    r9892 r9977  
    5050      !!                  ***  SUBROUTINE bdy_ice  *** 
    5151      !! 
    52       !! ** Purpose : - Apply open boundary conditions for ice (SI3) 
     52      !! ** Purpose : Apply open boundary conditions for sea ice 
    5353      !! 
    5454      !!---------------------------------------------------------------------- 
    5555      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    5656      ! 
    57       INTEGER ::   ib_bdy   ! Loop index 
     57      INTEGER ::   jbdy   ! BDY set index 
    5858      !!---------------------------------------------------------------------- 
    5959      ! 
    60       IF( ln_timing )   CALL timing_start('bdy_ice') 
     60      IF( ln_timing )   CALL timing_start('bdy_ice_thd') 
    6161      ! 
    6262      CALL ice_var_glo2eqv 
    6363      ! 
    64       DO ib_bdy = 1, nb_bdy 
    65          ! 
    66          SELECT CASE( cn_ice(ib_bdy) ) 
     64      DO jbdy = 1, nb_bdy 
     65         ! 
     66         SELECT CASE( cn_ice(jbdy) ) 
    6767         CASE('none')   ;   CYCLE 
    68          CASE('frs' )   ;   CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     68         CASE('frs' )   ;   CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy ) 
    6969         CASE DEFAULT 
    7070            CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) 
     
    7979      ! 
    8080      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    81       IF( ln_timing )   CALL timing_stop('bdy_ice') 
     81      IF( ln_timing )   CALL timing_stop('bdy_ice_thd') 
    8282      ! 
    8383   END SUBROUTINE bdy_ice 
    8484 
    8585 
    86    SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) 
     86   SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy ) 
    8787      !!------------------------------------------------------------------------------ 
    8888      !!                 ***  SUBROUTINE bdy_ice_frs  *** 
    8989      !!                     
    90       !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case  
    91       !!              of unstructured open boundaries. 
     90      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields 
    9291      !!  
    9392      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three- 
     
    9796      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data 
    9897      INTEGER,         INTENT(in) ::   kt      ! main time-step counter 
    99       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     98      INTEGER,         INTENT(in) ::   jbdy    ! BDY set index 
    10099      ! 
    101100      INTEGER  ::   jpbound            ! 0 = incoming ice 
    102101      !                                ! 1 = outgoing ice 
    103       INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices 
    104       INTEGER  ::   ji, jj, ii, ij     ! local scalar 
     102      INTEGER  ::   i_bdy, jgrd        ! dummy loop indices 
     103      INTEGER  ::   ji, jj, jk, jl, ib, jb 
    105104      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    106105      REAL(wp) ::   ztmelts, zdh 
     
    110109      ! 
    111110      DO jl = 1, jpl 
    112          DO jb = 1, idx%nblenrim(jgrd) 
    113             ji    = idx%nbi(jb,jgrd) 
    114             jj    = idx%nbj(jb,jgrd) 
    115             zwgt  = idx%nbw(jb,jgrd) 
    116             zwgt1 = 1.e0 - idx%nbw(jb,jgrd) 
    117             a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction  
    118             h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth  
    119             h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth 
     111         DO i_bdy = 1, idx%nblenrim(jgrd) 
     112            ji    = idx%nbi(i_bdy,jgrd) 
     113            jj    = idx%nbj(i_bdy,jgrd) 
     114            zwgt  = idx%nbw(i_bdy,jgrd) 
     115            zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 
     116            a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction  
     117            h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth  
     118            h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth 
    120119 
    121120            ! ----------------- 
     
    135134 
    136135         ENDDO 
    137          CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 
    138          CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy ) 
    139          CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy ) 
    140136      ENDDO 
     137      CALL lbc_bdy_lnk( a_i(:,:,:), 'T', 1., jbdy ) 
     138      CALL lbc_bdy_lnk( h_i(:,:,:), 'T', 1., jbdy ) 
     139      CALL lbc_bdy_lnk( h_s(:,:,:), 'T', 1., jbdy ) 
    141140 
    142141      DO jl = 1, jpl 
    143          DO jb = 1, idx%nblenrim(jgrd) 
    144             ji    = idx%nbi(jb,jgrd) 
    145             jj    = idx%nbj(jb,jgrd) 
     142         DO i_bdy = 1, idx%nblenrim(jgrd) 
     143            ji = idx%nbi(i_bdy,jgrd) 
     144            jj = idx%nbj(i_bdy,jgrd) 
    146145 
    147146            ! condition on ice thickness depends on the ice velocity 
    148147            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 
    149             jpbound = 0   ;   ii = ji   ;   ij = jj 
    150             ! 
    151             IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    152             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    153             IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    154             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    155             ! 
    156             IF( nn_ice_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
    157             !                                                             !      do not make state variables dependent on velocity 
    158             ! 
    159             IF( a_i(ii,ij,jl) > 0._wp ) THEN   ! there is ice at the boundary 
    160                ! 
    161                a_i(ji,jj,jl) = a_i(ii,ij,jl) ! concentration 
    162                h_i(ji,jj,jl) = h_i(ii,ij,jl) ! thickness ice 
    163                h_s(ji,jj,jl) = h_s(ii,ij,jl) ! thickness snw 
     148            jpbound = 0   ;   ib = ji   ;   jb = jj 
     149            ! 
     150            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji+1 ; jb = jj 
     151            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji-1 ; jb = jj 
     152            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. )   jpbound = 1 ; ib = ji   ; jb = jj+1 
     153            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. )   jpbound = 1 ; ib = ji   ; jb = jj-1 
     154            ! 
     155            IF( nn_ice_dta(jbdy) == 0 )   jpbound = 0 ; ib = ji ; jb = jj   ! case ice boundaries = initial conditions 
     156            !                                                               !      do not make state variables dependent on velocity 
     157            ! 
     158            IF( a_i(ib,jb,jl) > 0._wp ) THEN   ! there is ice at the boundary 
     159               ! 
     160               a_i(ji,jj,jl) = a_i(ib,jb,jl) ! concentration 
     161               h_i(ji,jj,jl) = h_i(ib,jb,jl) ! thickness ice 
     162               h_s(ji,jj,jl) = h_s(ib,jb,jl) ! thickness snw 
    164163               ! 
    165164               SELECT CASE( jpbound ) 
     
    167166               CASE( 0 )   ! velocity is inward 
    168167                  ! 
    169                   oa_i(ji,jj,  jl) = rn_ice_age(ib_bdy) * a_i(ji,jj,jl) ! age 
    170                   a_ip(ji,jj,  jl) = 0._wp                              ! pond concentration 
    171                   v_ip(ji,jj,  jl) = 0._wp                              ! pond volume 
    172                   t_su(ji,jj,  jl) = rn_ice_tem(ib_bdy)                 ! temperature surface 
    173                   t_s (ji,jj,:,jl) = rn_ice_tem(ib_bdy)                 ! temperature snw 
    174                   t_i (ji,jj,:,jl) = rn_ice_tem(ib_bdy)                 ! temperature ice 
    175                   s_i (ji,jj,  jl) = rn_ice_sal(ib_bdy)                 ! salinity 
    176                   sz_i(ji,jj,:,jl) = rn_ice_sal(ib_bdy)                 ! salinity profile 
     168                  oa_i(ji,jj,  jl) = rn_ice_age(jbdy) * a_i(ji,jj,jl) ! age 
     169                  a_ip(ji,jj,  jl) = 0._wp                            ! pond concentration 
     170                  v_ip(ji,jj,  jl) = 0._wp                            ! pond volume 
     171                  t_su(ji,jj,  jl) = rn_ice_tem(jbdy)                 ! temperature surface 
     172                  t_s (ji,jj,:,jl) = rn_ice_tem(jbdy)                 ! temperature snw 
     173                  t_i (ji,jj,:,jl) = rn_ice_tem(jbdy)                 ! temperature ice 
     174                  s_i (ji,jj,  jl) = rn_ice_sal(jbdy)                 ! salinity 
     175                  sz_i(ji,jj,:,jl) = rn_ice_sal(jbdy)                 ! salinity profile 
    177176                  ! 
    178177               CASE( 1 )   ! velocity is outward 
    179178                  ! 
    180                   oa_i(ji,jj,  jl) = oa_i(ii,ij,  jl) ! age 
    181                   a_ip(ji,jj,  jl) = a_ip(ii,ij,  jl) ! pond concentration 
    182                   v_ip(ji,jj,  jl) = v_ip(ii,ij,  jl) ! pond volume 
    183                   t_su(ji,jj,  jl) = t_su(ii,ij,  jl) ! temperature surface 
    184                   t_s (ji,jj,:,jl) = t_s (ii,ij,:,jl) ! temperature snw 
    185                   t_i (ji,jj,:,jl) = t_i (ii,ij,:,jl) ! temperature ice 
    186                   s_i (ji,jj,  jl) = s_i (ii,ij,  jl) ! salinity 
    187                   sz_i(ji,jj,:,jl) = sz_i(ii,ij,:,jl) ! salinity profile 
     179                  oa_i(ji,jj,  jl) = oa_i(ib,jb,  jl) ! age 
     180                  a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) ! pond concentration 
     181                  v_ip(ji,jj,  jl) = v_ip(ib,jb,  jl) ! pond volume 
     182                  t_su(ji,jj,  jl) = t_su(ib,jb,  jl) ! temperature surface 
     183                  t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) ! temperature snw 
     184                  t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) ! temperature ice 
     185                  s_i (ji,jj,  jl) = s_i (ib,jb,  jl) ! salinity 
     186                  sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) ! salinity profile 
    188187                  ! 
    189188               END SELECT 
     
    243242         END DO 
    244243         ! 
    245          CALL lbc_bdy_lnk( a_i (:,:,jl), 'T', 1., ib_bdy ) 
    246          CALL lbc_bdy_lnk( h_i (:,:,jl), 'T', 1., ib_bdy ) 
    247          CALL lbc_bdy_lnk( h_s (:,:,jl), 'T', 1., ib_bdy ) 
    248          CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy ) 
    249          CALL lbc_bdy_lnk( a_ip(:,:,jl), 'T', 1., ib_bdy ) 
    250          CALL lbc_bdy_lnk( v_ip(:,:,jl), 'T', 1., ib_bdy ) 
    251          CALL lbc_bdy_lnk( s_i (:,:,jl), 'T', 1., ib_bdy ) 
    252          CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy ) 
    253          CALL lbc_bdy_lnk( v_i (:,:,jl), 'T', 1., ib_bdy ) 
    254          CALL lbc_bdy_lnk( v_s (:,:,jl), 'T', 1., ib_bdy ) 
    255          CALL lbc_bdy_lnk( sv_i(:,:,jl), 'T', 1., ib_bdy ) 
    256           DO jk = 1, nlay_s 
    257             CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy ) 
    258             CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy ) 
    259          END DO 
    260          DO jk = 1, nlay_i 
    261             CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy ) 
    262             CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy ) 
    263          END DO 
    264          ! 
    265244      END DO ! jl 
     245 
     246      CALL lbc_bdy_lnk( a_i (:,:,:)  , 'T', 1., jbdy ) 
     247      CALL lbc_bdy_lnk( h_i (:,:,:)  , 'T', 1., jbdy ) 
     248      CALL lbc_bdy_lnk( h_s (:,:,:)  , 'T', 1., jbdy ) 
     249      CALL lbc_bdy_lnk( oa_i(:,:,:)  , 'T', 1., jbdy ) 
     250      CALL lbc_bdy_lnk( a_ip(:,:,:)  , 'T', 1., jbdy ) 
     251      CALL lbc_bdy_lnk( v_ip(:,:,:)  , 'T', 1., jbdy ) 
     252      CALL lbc_bdy_lnk( s_i (:,:,:)  , 'T', 1., jbdy ) 
     253      CALL lbc_bdy_lnk( t_su(:,:,:)  , 'T', 1., jbdy ) 
     254      CALL lbc_bdy_lnk( v_i (:,:,:)  , 'T', 1., jbdy ) 
     255      CALL lbc_bdy_lnk( v_s (:,:,:)  , 'T', 1., jbdy ) 
     256      CALL lbc_bdy_lnk( sv_i(:,:,:)  , 'T', 1., jbdy ) 
     257      CALL lbc_bdy_lnk( t_s (:,:,:,:), 'T', 1., jbdy ) 
     258      CALL lbc_bdy_lnk( e_s (:,:,:,:), 'T', 1., jbdy ) 
     259      CALL lbc_bdy_lnk( t_i (:,:,:,:), 'T', 1., jbdy ) 
     260      CALL lbc_bdy_lnk( e_i (:,:,:,:), 'T', 1., jbdy ) 
    266261      !       
    267262   END SUBROUTINE bdy_ice_frs 
     
    272267      !!                 ***  SUBROUTINE bdy_ice_dyn  *** 
    273268      !!                     
    274       !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries. 
    275       !!              u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free 
    276       !!              if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities 
     269      !! ** Purpose : Apply dynamics boundary conditions for sea-ice. 
    277270      !! 
    278       !! 2013-06 : C. Rousset 
     271      !! ** Method :  if this adjacent grid point is not ice free, then u_ice and v_ice take its value 
     272      !!              if                          is     ice free, then u_ice and v_ice are unchanged by BDY 
     273      !!                                                           they keep values calculated in rheology 
     274      !! 
    279275      !!------------------------------------------------------------------------------ 
    280276      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
    281277      ! 
    282       INTEGER  ::   jb, jgrd           ! dummy loop indices 
    283       INTEGER  ::   ji, jj             ! local scalar 
    284       INTEGER  ::   ib_bdy             ! Loop index 
     278      INTEGER  ::   i_bdy, jgrd      ! dummy loop indices 
     279      INTEGER  ::   ji, jj           ! local scalar 
     280      INTEGER  ::   jbdy             ! BDY set index 
    285281      REAL(wp) ::   zmsk1, zmsk2, zflag 
    286282      !!------------------------------------------------------------------------------ 
    287       ! 
    288       DO ib_bdy=1, nb_bdy 
    289          ! 
    290          SELECT CASE( cn_ice(ib_bdy) ) 
     283      IF( ln_timing )   CALL timing_start('bdy_ice_dyn') 
     284      ! 
     285      DO jbdy=1, nb_bdy 
     286         ! 
     287         SELECT CASE( cn_ice(jbdy) ) 
    291288         ! 
    292289         CASE('none') 
     
    295292         CASE('frs') 
    296293            ! 
    297             IF( nn_ice_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
    298             !                                              !      do not change ice velocity (it is only computed by rheology) 
     294            IF( nn_ice_dta(jbdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
     295            !                                            !      do not change ice velocity (it is only computed by rheology) 
    299296            SELECT CASE ( cd_type ) 
    300297            !      
    301298            CASE ( 'U' )   
    302299               jgrd = 2      ! u velocity 
    303                DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    304                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    305                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    306                   zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 
     300               DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 
     301                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
     302                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     303                  zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 
    307304                  ! 
    308305                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
     
    320317                  ! 
    321318               END DO 
    322                CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
     319               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., jbdy ) 
    323320               ! 
    324321            CASE ( 'V' ) 
    325322               jgrd = 3      ! v velocity 
    326                DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    327                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    328                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    329                   zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 
     323               DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 
     324                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
     325                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     326                  zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 
    330327                  ! 
    331328                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 
     
    343340                  ! 
    344341               END DO 
    345                CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
     342               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., jbdy ) 
    346343               ! 
    347344            END SELECT 
     
    352349         ! 
    353350      END DO 
     351      ! 
     352      IF( ln_timing )   CALL timing_stop('bdy_ice_dyn') 
    354353      ! 
    355354    END SUBROUTINE bdy_ice_dyn 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/CRS/crsdom.F90

    r9892 r9977  
    22462246      
    22472247      zmbk(:,:) = 0.0 
    2248       zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) ) 
     2248      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = NINT( zmbk(:,:) ) 
    22492249 
    22502250 
     
    22662266      ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    22672267      zmbk(:,:) = 1.e0;     
    2268       zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 )  
    2269       zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 )  
     2268      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 )  
     2269      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 )  
    22702270      ! 
    22712271   END SUBROUTINE crs_dom_bat 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DIA/dia25h.F90

    r9892 r9977  
    139139      ! ----------------- 
    140140      ! Define frequency of summing to create 25 h mean 
    141       IF( MOD( 3600,INT(rdt) ) == 0 ) THEN 
    142          i_steps = 3600/INT(rdt) 
     141      IF( MOD( 3600,NINT(rdt) ) == 0 ) THEN 
     142         i_steps = 3600/NINT(rdt) 
    143143      ELSE 
    144144         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible') 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DOM/domain.F90

    r9893 r9977  
    543543         ! 
    544544         cd_cfg = 'ORCA' 
    545          CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res ) 
     545         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res ) 
    546546         ! 
    547547         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1 
     
    563563      ENDIF 
    564564      ! 
    565       CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo ) 
    566       CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo ) 
    567       CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo ) 
    568       CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio ) 
     565      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = NINT( ziglo ) 
     566      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = NINT( zjglo ) 
     567      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = NINT( zkglo ) 
     568      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio ) 
    569569      CALL iom_close( inum ) 
    570570      ! 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DOM/domzgr.F90

    r9892 r9977  
    253253      !                          !* ocean top and bottom level 
    254254      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF) 
    255       k_top(:,:) = INT( z2d(:,:) ) 
     255      k_top(:,:) = NINT( z2d(:,:) ) 
    256256      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points 
    257       k_bot(:,:) = INT( z2d(:,:) ) 
     257      k_bot(:,:) = NINT( z2d(:,:) ) 
    258258      ! 
    259259      ! reference depth for negative bathy (wetting and drying only) 
     
    307307      END DO 
    308308      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    309       zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   miku(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    310       zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mikv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    311       zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( zk, 'F', 1. )   ;   mikf(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    312       ! 
    313       zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   mbku(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    314       zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     309      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     310      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     311      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( zk, 'F', 1. )   ;   mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     312      ! 
     313      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     314      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    315315      ! 
    316316   END SUBROUTINE zgr_top_bot 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/IOM/iom.F90

    r9892 r9977  
    8383      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 
    8484   END INTERFACE iom_put 
    85     
    86    LOGICAL, PARAMETER ::   ltmppatch = .TRUE.     !: seb: patch before we remove periodicity 
    87    INTEGER            ::   nldi_save, nlei_save   !:      and close boundaries in output files 
    88    INTEGER            ::   nldj_save, nlej_save   !: 
    8985   
    9086   !!---------------------------------------------------------------------- 
     
    9591CONTAINS 
    9692 
    97    SUBROUTINE iom_init( cdname, fname )  
     93   SUBROUTINE iom_init( cdname, fname, ld_tmppatch )  
    9894      !!---------------------------------------------------------------------- 
    9995      !!                     ***  ROUTINE   *** 
     
    10298      !! 
    10399      !!---------------------------------------------------------------------- 
    104       CHARACTER(len=*), INTENT(in)  :: cdname 
     100      CHARACTER(len=*),           INTENT(in)  :: cdname 
    105101      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname 
     102      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch 
    106103#if defined key_iomput 
    107104      ! 
     
    113110      ! 
    114111      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
     112      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
     113      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
     114      INTEGER ::   nldj_save, nlej_save    !: 
    115115      !!---------------------------------------------------------------------- 
    116116      ! 
    117117      ! seb: patch before we remove periodicity and close boundaries in output files 
    118       IF ( ltmppatch ) THEN 
     118      IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch 
     119      ELSE                              ;   ll_tmppatch = .TRUE. 
     120      ENDIF 
     121      IF ( ll_tmppatch ) THEN 
    119122         nldi_save = nldi   ;   nlei_save = nlei 
    120123         nldj_save = nldj   ;   nlej_save = nlej 
     
    246249      DEALLOCATE( zt_bnds, zw_bnds ) 
    247250      ! 
    248       IF ( ltmppatch ) THEN 
     251      IF ( ll_tmppatch ) THEN 
    249252         nldi = nldi_save   ;   nlei = nlei_save 
    250253         nldj = nldj_save   ;   nlej = nlej_save 
     
    19241927      !!---------------------------------------------------------------------- 
    19251928      ! 
    1926       ! seb: patch before we remove periodicity and close boundaries in output files 
    1927       IF ( ltmppatch ) THEN 
    1928          nldi_save = nldi   ;   nlei_save = nlei 
    1929          nldj_save = nldj   ;   nlej_save = nlej 
    1930          IF( nimpp           ==      1 ) nldi = 1 
    1931          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    1932          IF( njmpp           ==      1 ) nldj = 1 
    1933          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    1934       ENDIF 
    1935       ! 
    19361929      ni = nlei-nldi+1 
    19371930      nj = nlej-nldj+1 
     
    19551948      ENDIF 
    19561949      ! 
    1957       IF ( ltmppatch ) THEN 
    1958          nldi = nldi_save   ;   nlei = nlei_save 
    1959          nldj = nldj_save   ;   nlej = nlej_save 
    1960       ENDIF 
    1961       ! 
    19621950   END SUBROUTINE set_grid 
    19631951 
     
    19811969      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_rot       ! Lat/lon working array for rotation of cells 
    19821970      !!---------------------------------------------------------------------- 
    1983       ! 
    1984       ! seb: patch before we remove periodicity and close boundaries in output files 
    1985       IF ( ltmppatch ) THEN 
    1986          nldi_save = nldi   ;   nlei_save = nlei 
    1987          nldj_save = nldj   ;   nlej_save = nlej 
    1988          IF( nimpp           ==      1 ) nldi = 1 
    1989          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    1990          IF( njmpp           ==      1 ) nldj = 1 
    1991          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    1992       ENDIF 
    19931971      ! 
    19941972      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  ) 
     
    20752053      DEALLOCATE( z_bnds, z_fld, z_rot )  
    20762054      ! 
    2077       IF ( ltmppatch ) THEN 
    2078          nldi = nldi_save   ;   nlei = nlei_save 
    2079          nldj = nldj_save   ;   nlej = nlej_save 
    2080       ENDIF 
    2081       ! 
    20822055   END SUBROUTINE set_grid_bounds 
    20832056 
     
    20952068      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    20962069      !!---------------------------------------------------------------------- 
    2097       ! 
    2098       ! seb: patch before we remove periodicity and close boundaries in output files 
    2099       IF ( ltmppatch ) THEN 
    2100          nldi_save = nldi   ;   nlei_save = nlei 
    2101          nldj_save = nldj   ;   nlej_save = nlej 
    2102          IF( nimpp           ==      1 ) nldi = 1 
    2103          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    2104          IF( njmpp           ==      1 ) nldj = 1 
    2105          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    2106       ENDIF 
    21072070      ! 
    21082071      ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk) 
     
    21192082      ! 
    21202083      CALL iom_update_file_name('ptr') 
    2121       ! 
    2122       IF ( ltmppatch ) THEN 
    2123          nldi = nldi_save   ;   nlei = nlei_save 
    2124          nldj = nldj_save   ;   nlej = nlej_save 
    2125       ENDIF 
    21262084      ! 
    21272085   END SUBROUTINE set_grid_znl 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/IOM/restart.F90

    r9893 r9977  
    129129                  clpname = TRIM(Agrif_CFixed())//"_"//clname    
    130130               ENDIF 
    131                CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname)) 
     131               CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname), .false. ) 
    132132               CALL xios_update_calendar(nitrst) 
    133133               CALL iom_swap(      cxios_context          ) 
     
    239239             IF( .NOT.lxios_set ) THEN 
    240240                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 
    241                  CALL iom_init( crxios_context ) 
     241                 CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
    242242                 lxios_set = .TRUE. 
    243243             ENDIF 
    244244         ENDIF 
    245245         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 
    246              CALL iom_init( crxios_context ) 
     246             CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
    247247             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 
    248248             lxios_set = .TRUE. 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/lbclnk.F90

    r9892 r9977  
    3838   ! 
    3939   INTERFACE lbc_bdy_lnk 
    40       MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     40      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 
    4141   END INTERFACE 
    4242   ! 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/lib_mpp.F90

    r9892 r9977  
    8888   PUBLIC   mppsize 
    8989   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    90    PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     90   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 
    9191   PUBLIC   mpprank 
    9292    
     
    456456   !                       !==  4D array and array of 4D pointer  ==! 
    457457   ! 
    458 !!#  define DIM_4d 
    459 !!#     define ROUTINE_BDY           mpp_lnk_bdy_4d 
    460 !!#     include "mpp_bdy_generic.h90" 
    461 !!#     undef ROUTINE_BDY 
    462 !!#  undef DIM_4d 
     458#  define DIM_4d 
     459#     define ROUTINE_BDY           mpp_lnk_bdy_4d 
     460#     include "mpp_bdy_generic.h90" 
     461#     undef ROUTINE_BDY 
     462#  undef DIM_4d 
    463463 
    464464   !!---------------------------------------------------------------------- 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/mpp_nfd_generic.h90

    r9805 r9977  
    5656      INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array 
    5757      INTEGER  ::   imigr, iihom, ijhom             ! local integers 
    58       INTEGER  ::   ierr, itaille, ildi, ilei, iilb 
     58      INTEGER  ::   ierr, itaille, ilci, ildi, ilei, iilb 
    5959      INTEGER  ::   ij, iproc 
    6060      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather 
     
    117117            IF(iproc /= -1) THEN 
    118118               iilb = nimppt(iproc+1) 
     119               ilci = nlcit (iproc+1) 
    119120               ildi = nldit (iproc+1) 
    120121               ilei = nleit (iproc+1) 
    121                IF( iilb           ==      1 )   ildi = 1     ! e-w boundary already done -> force to take 1st column 
    122                IF( iilb + jpi - 1 == jpiglo )   ilei = jpi   ! e-w boundary already done -> force to take last column 
     122               IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column 
     123               IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column 
    123124               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    124125            ENDIF 
     
    185186            iproc = nrank_north(jr) + 1 
    186187            iilb  = nimppt(iproc) 
     188            ilci  = nlcit (iproc) 
    187189            ildi  = nldit (iproc) 
    188190            ilei  = nleit (iproc) 
    189             IF( iilb           ==      1 )   ildi = 1     ! e-w boundary already done -> force to take 1st column 
    190             IF( iilb + jpi - 1 == jpiglo )   ilei = jpi   ! e-w boundary already done -> force to take last column 
     191            IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column 
     192            IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column 
    191193            DO jf = 1, ipf 
    192194               DO jl = 1, ipl 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/mppini.F90

    r9892 r9977  
    536536               &                                ibonit (jproc), ibonjt (jproc)  
    537537         END DO 
    538          CLOSE(inum)    
    539538      END IF 
    540539 
     
    577576      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
    578577         CALL mpp_ini_north 
    579          IF(lwp) WRITE(numout,*) 
    580          IF(lwp) WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1' 
     578         IF (lwp) THEN 
     579            WRITE(numout,*) 
     580            WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1' 
     581            ! additional prints in layout.dat 
     582            WRITE(inum,*) 
     583            WRITE(inum,*) 
     584            WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north 
     585            WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 
     586            DO jproc = 1, ndim_rank_north, 5 
     587               WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) ) 
     588            END DO 
     589         ENDIF 
    581590      ENDIF 
    582591      ! 
    583592      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary) 
    584593      ! 
    585       IF( ln_nnogather )   CALL mpp_init_nfdcom     ! northfold neighbour lists 
     594      IF( ln_nnogather ) THEN 
     595         CALL mpp_init_nfdcom     ! northfold neighbour lists 
     596         IF (lwp) THEN 
     597            WRITE(inum,*) 
     598            WRITE(inum,*) 
     599            WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 
     600            WRITE(inum,*) 'nfsloop : ', nfsloop 
     601            WRITE(inum,*) 'nfeloop : ', nfeloop 
     602            WRITE(inum,*) 'nsndto : ', nsndto 
     603            WRITE(inum,*) 'isendto : ', isendto 
     604         ENDIF 
     605      ENDIF 
     606      ! 
     607      IF (lwp) CLOSE(inum)    
    586608      ! 
    587609      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    & 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbc_ice.F90

    r9892 r9977  
    4949   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qml_ice        !: heat available for snow / ice surface melting     [W/m2]  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice        !: heat conduction flux in the layer below surface   [W/m2]  
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_tr     !: solar flux transmitted below the ice surface      [W/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_top    !: solar flux transmitted below the ice surface      [W/m2] 
    5252 
    5353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     
    126126      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice  (jpi,jpj,jpl) ,     & 
    127127         &      qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) ,     & 
    128          &      dqns_ice(jpi,jpj,jpl) , tn_ice   (jpi,jpj,jpl) , alb_ice   (jpi,jpj,jpl) ,   & 
    129          &      qml_ice (jpi,jpj,jpl) , qcn_ice  (jpi,jpj,jpl) , qsr_ice_tr(jpi,jpj,jpl) ,   & 
    130          &      utau_ice(jpi,jpj)     , vtau_ice (jpi,jpj)     , wndm_ice  (jpi,jpj)     ,   & 
    131          &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj)     ,   & 
    132          &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce  (jpi,jpj)     ,   & 
    133          &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce   (jpi,jpj)     ,   & 
    134          &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz    (jpi,jpj)     , STAT= ierr(2) ) 
     128         &      dqns_ice(jpi,jpj,jpl) , tn_ice   (jpi,jpj,jpl) , alb_ice    (jpi,jpj,jpl) ,   & 
     129         &      qml_ice (jpi,jpj,jpl) , qcn_ice  (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) ,   & 
     130         &      utau_ice(jpi,jpj)     , vtau_ice (jpi,jpj)     , wndm_ice   (jpi,jpj)     ,   & 
     131         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice  (jpi,jpj)     ,   & 
     132         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce   (jpi,jpj)     ,   & 
     133         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce    (jpi,jpj)     ,   & 
     134         &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz     (jpi,jpj)     , STAT= ierr(2) ) 
    135135#endif 
    136136 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbcblk.F90

    r9892 r9977  
    907907      ! 
    908908      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    909          qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
     909         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    910910      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    911          qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) * zfr1 
     911         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    912912      ELSEWHERE                                                         ! zero when hs>0 
    913          qsr_ice_tr(:,:,:) = 0._wp  
     913         qtr_ice_top(:,:,:) = 0._wp  
    914914      END WHERE 
    915915      ! 
     
    10001000               ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature 
    10011001               ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature 
    1002                zqa0    = qsr_ice(ji,jj,jl) - qsr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 
     1002               zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 
    10031003               ! 
    10041004               DO iter = 1, nit     ! --- Iterative loop 
     
    10111011               qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 
    10121012               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 
    1013                qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qsr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )   & 
     1013               qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  & 
    10141014                             &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
    10151015 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbccpl.F90

    r9892 r9977  
    19991999      !                                                      ! ========================= ! 
    20002000      CASE ('coupled') 
    2001          qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:) 
    2002          qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:) 
     2001         qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
     2002         qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
    20032003      END SELECT 
    20042004      ! 
     
    20122012         ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission parameter (Grenfell Maykut 77) 
    20132013         ! 
    2014          qsr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:) 
    2015          WHERE( phs(:,:,:) >= 0.0_wp )   qsr_ice_tr(:,:,:) = 0._wp            ! snow fully opaque 
    2016          WHERE( phi(:,:,:) <= 0.1_wp )   qsr_ice_tr(:,:,:) = qsr_ice(:,:,:)   ! thin ice transmits all solar radiation 
     2014         qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 
     2015         WHERE( phs(:,:,:) >= 0.0_wp )   qtr_ice_top(:,:,:) = 0._wp            ! snow fully opaque 
     2016         WHERE( phi(:,:,:) <= 0.1_wp )   qtr_ice_top(:,:,:) = qsr_ice(:,:,:)   ! thin ice transmits all solar radiation 
    20172017         !      
    20182018      CASE( np_jules_ACTIVE )       !==  Jules coupler is active  ==! 
    20192019         ! 
    2020          !                    ! ===> here we must receive the qsr_ice_tr array from the coupler 
     2020         !                    ! ===> here we must receive the qtr_ice_top array from the coupler 
    20212021         !                           for now just assume zero (fully opaque ice) 
    2022          qsr_ice_tr(:,:,:) = 0._wp 
     2022         qtr_ice_top(:,:,:) = 0._wp 
    20232023         ! 
    20242024      END SELECT 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/TRA/traadv_fct.F90

    r9892 r9977  
    548548!!gm   
    549549      ! 
     550      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case 
     551         zwd(:,:,2) = 1._wp  ;  zwi(:,:,2) = 0._wp  ;  zws(:,:,2) = 0._wp  ;  zwrm(:,:,2) = 0._wp 
     552      END IF 
     553      ! 
    550554      DO jj = 2, jpjm1                 ! 2nd order centered at top & bottom 
    551555         DO ji = fs_2, fs_jpim1 
     
    556560            zwi (ji,jj,ikt) = 0._wp 
    557561            zws (ji,jj,ikt) = 0._wp 
    558             zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 
     562            zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) ) 
    559563            ! 
    560564            zwd (ji,jj,ikb) = 1._wp          ! bottom 
    561565            zwi (ji,jj,ikb) = 0._wp 
    562566            zws (ji,jj,ikb) = 0._wp 
    563             zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )             
     567            zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )             
    564568         END DO 
    565569      END DO    
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/TRA/trabbl.F90

    r9892 r9977  
    526526      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp )   
    527527      CALL lbc_lnk_multi( zmbku,'U',1., zmbkv,'V',1.)  
    528       mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( INT( zmbkv(:,:) ), 1 ) 
     528      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 
    529529      ! 
    530530      !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/USR/usrdef_zgr.F90

    r9892 r9977  
    204204      CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    205205      ! 
    206       k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     206      k_bot(:,:) = NINT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
    207207      ! 
    208208      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/stpctl.F90

    r9892 r9977  
    114114         CALL mpp_max_multiple( zmax(:), 5 )    ! max over the global domain 
    115115         ! 
    116          nstop = INT( zmax(5) )                 ! nstop indicator sheared among all local domains 
     116         nstop = NINT( zmax(5) )                 ! nstop indicator sheared among all local domains 
    117117      ENDIF 
    118118      ! 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/timing.F90

    r9892 r9977  
    211211         WRITE(numtime,*) '                             NEMO team' 
    212212         WRITE(numtime,*) '                  Ocean General Circulation Model' 
    213          WRITE(numtime,*) '                        version 3.6  (2015) ' 
     213         WRITE(numtime,*) '                        version 4.0  (2018) ' 
    214214         WRITE(numtime,*) 
    215215         WRITE(numtime,*) '                        Timing Informations ' 
  • NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/TOP/PISCES/P4Z/p4zsms.F90

    r9892 r9977  
    300300         IF( ln_p5z ) THEN 
    301301            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 
    302                CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sized(:,:,:)  ) 
    303                CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sized(:,:,:)  ) 
     302               CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:)  ) 
     303               CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:)  ) 
    304304               CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  ) 
    305305            ELSE 
     
    321321         CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 
    322322         IF( ln_p5z ) THEN 
    323             CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sized(:,:,:) ) 
    324             CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sized(:,:,:) ) 
     323            CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sizep(:,:,:) ) 
     324            CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sizen(:,:,:) ) 
    325325            CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) 
    326326         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.