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

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

Changeset 12154 for NEMO/branches/2019


Ignore:
Timestamp:
2019-12-10T15:44:23+01:00 (4 years ago)
Author:
cetlod
Message:

commit

Location:
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019
Files:
2 deleted
44 edited
10 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r11536 r12154  
    9393!----------------------------------------------------------------------- 
    9494   !                    !  bulk algorithm : 
    95    ln_NCAR    = .true.     ! "NCAR"      algorithm   (Large and Yeager 2008) 
    96  
     95   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     96   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     97   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     98   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     99      ! 
     100      rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
     101      rn_zu       = 10.       !  Wind vector reference height (m) 
     102      ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
     103      ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
     104      rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
     105      rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     106      rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
     107      !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
     108      ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
     109      ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
     110      ! 
     111      ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
     112      ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
     113      ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
     114   ! 
    97115   cn_dir = './'  !  root directory for the bulk data location 
    98116   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    … …  
    108126   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    109127   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    110    sn_tdif     = 'taudif_core'                ,   24.        , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    111128/ 
    112129!----------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

    r11536 r12154  
    8989!----------------------------------------------------------------------- 
    9090   !                    !  bulk algorithm : 
    91    ln_NCAR     = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    92  
     91   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     92   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     93   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     94   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     95      ! 
     96      rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
     97      rn_zu       = 10.       !  Wind vector reference height (m) 
     98      ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
     99      ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
     100      rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
     101      rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     102      rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
     103      !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
     104      ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
     105      ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
     106      ! 
     107      ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
     108      ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
     109      ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
     110   ! 
    93111   cn_dir      = './'      !  root directory for the bulk data location 
    94112   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    … …  
    104122   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core2_nordic1_bilin.nc'  , ''       , '' 
    105123   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core2_nordic1_bilin.nc'  , ''       , '' 
    106    sn_tdif     = 'taudif_core'                ,   24.        , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core2_nordic1_bilin.nc'  , ''       , '' 
    107124 
    108125/ 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/AGRIF_DEMO/EXPREF/2_namelist_ice_ref

    r9575 r12154  
    1 link 1_namelist_ice_ref 
     1link ../../SHARED/namelist_ice_ref 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/AGRIF_DEMO/EXPREF/2_namelist_ref

    r9464 r12154  
    1 link 1_namelist_ref 
     1link ../../SHARED/namelist_ref 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

    r11536 r12154  
    104104   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core2_nordic2_bilin.nc'     , ''       , '' 
    105105   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core2_nordic2_bilin.nc'     , ''       , '' 
    106    sn_tdif     = 'taudif_core'                ,   24.        , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core2_nordic2_bilin.nc'     , ''       , '' 
    107106 
    108107/ 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r11536 r12154  
    9393!----------------------------------------------------------------------- 
    9494   !                    !  bulk algorithm : 
    95    ln_NCAR    = .true.     ! "NCAR"      algorithm   (Large and Yeager 2008) 
    96  
     95   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     96   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     97   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     98   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     99      ! 
     100      rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
     101      rn_zu       = 10.       !  Wind vector reference height (m) 
     102      ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
     103      ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
     104      rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
     105      rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     106      rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
     107      !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
     108      ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
     109      ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
     110      ! 
     111      ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
     112      ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
     113      ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
     114   ! 
    97115   cn_dir = './'  !  root directory for the bulk data location 
    98116   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    … …  
    108126   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    109127   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    110    sn_tdif     = 'taudif_core'                ,   24.        , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    111128/ 
    112129!----------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/C1D_PAPA/EXPREF/namelist_cfg

    r11536 r12154  
    159159   sn_snow     = 'forcing_C1D_PAPA'   ,  3.   , 'sososnow',   .false.    , .false. , 'yearly'  , ''  , ''   , '' 
    160160   sn_slp      = 'forcing_C1D_PAPA'   ,  3.   , 'somslpre',   .true.     , .false. , 'yearly'  , ''  , ''   , '' 
    161    sn_tdif     = 'forcing_C1D_PAPA'   , 24.   , 'taudif'  ,   .false.    , .false. , 'yearly'  , ''  , ''   , '' 
    162161 
    163162/ 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/ORCA2_ICE_ABL/EXPREF/file_def_nemo-oce.xml

    r11306 r12154  
    99    --> 
    1010    
    11     <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="6h" min_digits="4"> 
     11    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="5d" min_digits="4"> 
    1212     
    13       <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE.">  <!-- 6h files -->    
     13      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->    
    1414        <file id="file11" name_suffix="_grid_T" description="ocean T grid variables" > 
    1515          <field field_ref="e3t"      /> 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg

    r11945 r12154  
    8989   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
    9090   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
     91   ln_dm2dc    = .true.    !  daily mean to diurnal cycle on short wave 
    9192   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
    9293   nn_fwb      = 2         !  FreshWater Budget:  
    … …  
    107108!----------------------------------------------------------------------- 
    108109   !                    !  bulk algorithm : 
    109    ln_NCAR    = .true.     ! "NCAR"      algorithm   (Large and Yeager 2008) 
    110  
     110   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     111   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     112   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     113   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     114      rn_zqt      = 10.     !  Air temperature & humidity reference height (m) 
     115      rn_zu       = 10.     !  Wind vector reference height (m) 
     116      ! 
     117      ! Skin is ONLY available in ECMWF and COARE algorithms: 
     118      ln_skin_cs = .false.  !  use the cool-skin parameterization => set nn_fsbc=1 and ln_dm2dc=.true.! 
     119      ln_skin_wl = .false.  !  use the warm-layer        "        => set nn_fsbc=1 and ln_dm2dc=.true.! 
     120      ! 
     121      ln_humi_sph = .true.  !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
     122      ln_humi_dpt = .false. !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
     123      ln_humi_rlh = .false. !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
     124   ! 
    111125   cn_dir = './'  !  root directory for the bulk data location 
    112126   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    … …  
    404418!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    405419!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    406 !!   namflo       float parameters                                      ("key_float") 
    407 !!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm") 
    408 !!   namdct       transports through some sections                      ("key_diadct") 
     420!!   namflo       float parameters                                      (default: OFF) 
     421!!   nam_diaharm  Harmonic analysis of tidal constituents               (default: OFF) 
     422!!   nam_diadct   transports through some sections                      (default: OFF) 
    409423!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
    410424!!   nam_dia25h   25h Mean Output                                       (default: OFF) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r11536 r12154  
    118118   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    119119   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    120    sn_tdif     = 'taudif_core'                ,   24.        , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    121120/ 
    122121!----------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

    r11536 r12154  
    6464&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk =T) 
    6565!----------------------------------------------------------------------- 
    66    ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008) 
    67  
     66   !                    !  bulk algorithm : 
     67   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     68   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     69   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     70   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     71      ! 
     72      rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
     73      rn_zu       = 10.       !  Wind vector reference height (m) 
     74      ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
     75      ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
     76      rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
     77      rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     78      rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
     79      !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
     80      ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
     81      ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
     82      ! 
     83      ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
     84      ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
     85      ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
     86   ! 
    6887   cn_dir      = './'      !  root directory for the bulk data location 
    6988   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    … …  
    7998   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    8099   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    81    sn_tdif     = 'taudif_core'                ,   24.        , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    82100/ 
    83101!----------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/SHARED/field_def_nemo-oce.xml

    r12109 r12154  
    4141   <field id="ahmt_3d"      long_name=" 3D      t-eddy viscosity coefficient"   unit="m2/s or m4/s"  grid_ref="grid_T_3D"/> 
    4242 
    43         <field id="sst"          long_name="sea surface temperature"                            standard_name="sea_surface_temperature"             unit="degC"     /> 
     43        <field id="sst"          long_name="Bulk sea surface temperature"                       standard_name="bulk_sea_surface_temperature"        unit="degC"     /> 
     44        <field id="t_skin"       long_name="Skin temperature aka SSST"                          standard_name="skin_temperature"                    unit="degC"     /> 
    4445        <field id="sst2"         long_name="square of sea surface temperature"                  standard_name="square_of_sea_surface_temperature"   unit="degC2"     > sst * sst </field > 
    4546        <field id="sstmax"       long_name="max of sea surface temperature"   field_ref="sst"   operation="maximum"                                                 /> 
    … …  
    300301 
    301302          <!-- *_oce variables available with ln_blk_clio or ln_blk_core --> 
     303          <field id="rho_air"      long_name="Air density at 10m above sea surface"         standard_name="rho_air_10m"                                        unit="kg/m3" /> 
     304          <field id="dt_skin"      long_name="SSST-SST temperature difference"              standard_name="SSST-SST"                                             unit="K"   /> 
    302305          <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"  standard_name="surface_net_downward_longwave_flux"                 unit="W/m2"  /> 
    303306          <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"  standard_name="surface_downward_sensible_heat_flux"                unit="W/m2"  /> 
    304307          <field id="qla_oce"      long_name="Latent Downward Heat Flux over open ocean"    standard_name="surface_downward_latent_heat_flux"                  unit="W/m2"  /> 
     308          <field id="evap_oce"     long_name="Evaporation over open ocean"                  standard_name="evaporation"                                        unit="kg/m2/s" /> 
    305309          <field id="qt_oce"       long_name="total flux at ocean surface"                  standard_name="surface_downward_heat_flux_in_sea_water"            unit="W/m2"  /> 
    306310          <field id="qsr_oce"      long_name="solar heat flux at ocean surface"             standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"  /> 
    … …  
    362366   </field_group> 
    363367    
    364    <!-- scalar variables --> 
    365    <field_group id="SBC_0D"  grid_ref="grid_1point" > 
     368 
     369      </field_group> <!-- SBC --> 
     370       
     371      <!-- ABL --> 
     372      <field_group id="ABL" > <!-- time step automaticaly defined based on nn_fsbc --> 
     373 
     374   <!-- variables available with ABL on atmospheric T grid--> 
     375   <field_group id="grid_ABL3D" grid_ref="grid_TA_3D" > 
     376          <field id="u_abl"      long_name="ABL i-horizontal velocity"     standard_name="abl_x_velocity" unit="m/s"      /> 
     377          <field id="v_abl"      long_name="ABL j-horizontal velocity"     standard_name="abl_y_velocity" unit="m/s"      /> 
     378          <field id="t_abl"      long_name="ABL potential temperature"     standard_name="abl_theta"      unit="K"        /> 
     379          <field id="q_abl"      long_name="ABL specific humidity"         standard_name="abl_qspe"       unit="kg/kg"    /> 
     380          <!-- debug (to be removed) --> 
     381          <field id="u_dta"      long_name="DTA i-horizontal velocity"     standard_name="dta_x_velocity" unit="m/s"      /> 
     382          <field id="v_dta"      long_name="DTA j-horizontal velocity"     standard_name="dta_y_velocity" unit="m/s"      /> 
     383          <field id="t_dta"      long_name="DTA potential temperature"     standard_name="dta_theta"      unit="K"        /> 
     384          <field id="q_dta"      long_name="DTA specific humidity"         standard_name="dta_qspe"       unit="kg/kg"    /> 
     385          <field id="coeft"      long_name="ABL nudging coefficient"       standard_name="coeft"          unit=""         /> 
     386          <field id="tke_abl"    long_name="ABL turbulent kinetic energy"  standard_name="abl_tke"        unit="m2/s2"    /> 
     387          <field id="avm_abl"    long_name="ABL turbulent viscosity"       standard_name="abl_avm"        unit="m2/s"     /> 
     388          <field id="avt_abl"    long_name="ABL turbulent diffusivity"     standard_name="abl_avt"        unit="m2/s"     /> 
     389          <field id="mxl_abl"    long_name="ABL mixing length"             standard_name="abl_mxl"        unit="m"        /> 
    366390   </field_group> 
    367391 
    368       </field_group> <!-- SBC --> 
    369  
     392   <field_group id="grid_ABL2D" grid_ref="grid_TA_2D" > 
     393          <field id="pblh"       long_name="ABL height"                    standard_name="abl_height"     unit="m"        /> 
     394          <field id="uz1_abl"    long_name="ABL i-horizontal velocity"     standard_name="abl_x_velocity" unit="m/s"      /> 
     395          <field id="vz1_abl"    long_name="ABL j-horizontal velocity"     standard_name="abl_y_velocity" unit="m/s"      /> 
     396          <field id="uvz1_abl"   long_name="ABL wind speed module"         standard_name="abl_wind_speed" unit="m/s"       > sqrt( uz1_abl^2 + vz1_abl^2 ) </field> 
     397          <field id="tz1_abl"    long_name="ABL potential temperature"     standard_name="abl_theta"      unit="K"        /> 
     398          <field id="qz1_abl"    long_name="ABL specific humidity"         standard_name="abl_qspe"       unit="kg/kg"    /> 
     399          <field id="uz1_dta"    long_name="DTA i-horizontal velocity"     standard_name="dta_x_velocity" unit="m/s"      /> 
     400          <field id="vz1_dta"    long_name="DTA j-horizontal velocity"     standard_name="dta_y_velocity" unit="m/s"      /> 
     401          <field id="uvz1_dta"   long_name="DTA wind speed module"         standard_name="dta_wind_speed" unit="m/s"       > sqrt( uz1_dta^2 + vz1_dta^2 ) </field>  
     402          <field id="tz1_dta"    long_name="DTA potential temperature"     standard_name="dta_theta"      unit="K"        /> 
     403          <field id="qz1_dta"    long_name="DTA specific humidity"         standard_name="dta_qspe"       unit="kg/kg"    /> 
     404          <!-- debug (to be removed) --> 
     405          <field id="uz1_geo"    long_name="GEO i-horizontal velocity"     standard_name="geo_x_velocity" unit="m/s"      /> 
     406          <field id="vz1_geo"    long_name="GEO j-horizontal velocity"     standard_name="geo_y_velocity" unit="m/s"      /> 
     407          <field id="uvz1_geo"   long_name="GEO wind speed module"         standard_name="geo_wind_speed" unit="m/s"       > sqrt( uz1_geo^2 + vz1_geo^2 ) </field>  
     408   </field_group> 
     409 
     410      </field_group> <!-- ABL --> 
     411 
     412       
    370413      <!-- U grid --> 
    371414       
    … …  
    391434        <field id="uocet"        long_name="ocean transport along i-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_U_3D" /> 
    392435        <field id="uoces"        long_name="ocean transport along i-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_U_3D" /> 
     436        <field id="ssuww"        long_name="ocean surface wind work along i-axis"                   standard_name="surface_x_wind_work"         unit="N/m*s"                            > utau * ssu </field> 
    393437 
    394438        <!-- u-eddy diffusivity coefficients (available if ln_traldf_OFF=F) --> 
    … …  
    448492        <field id="vocet"        long_name="ocean transport along j-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_V_3D" /> 
    449493        <field id="voces"        long_name="ocean transport along j-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_V_3D" /> 
     494        <field id="ssvww"        long_name="ocean surface wind work along j-axis"                   standard_name="surface_y_wind_work"         unit="N/m*s"                            > vtau * ssv </field> 
    450495 
    451496        <!-- v-eddy diffusivity coefficients (available if ln_traldf_OFF=F) --> 
    … …  
    589634 
    590635       
    591       <!-- variables available with key_float --> 
     636      <!-- variables available with ln_floats --> 
    592637 
    593638      <field_group id="floatvar" grid_ref="grid_T_nfloat"  operation="instant" > 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/SHARED/namelist_ref

    r12113 r12154  
    55!! namelists    2 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_cpl, 
    66!!                                    namsbc_sas, namtra_qsr, namsbc_rnf, 
    7 !!                                    namsbc_isf, namsbc_iscpl, namsbc_apr,  
     7!!                                    namsbc_isf, namsbc_iscpl, namsbc_apr, 
    88!!                                    namsbc_ssr, namsbc_wave, namberg) 
    99!!              3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) 
    … …  
    6565   ln_clobber  = .true.    !  clobber (overwrite) an existing file 
    6666   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
    67    ln_xios_read = .FALSE.  !  use XIOS to read restart file (only for a single file restart) 
     67   ln_xios_read = .false.  !  use XIOS to read restart file (only for a single file restart) 
    6868   nn_wxios = 0      !  use XIOS to write restart file 0 - no, 1 - single file output, 2 - multiple file output 
    6969/ 
    … …  
    8888      cn_domcfg = "domain_cfg"  ! domain configuration filename 
    8989      ! 
    90       ln_closea    = .false.    !  T => keep closed seas (defined by closea_mask field) in the   
     90      ln_closea    = .false.    !  T => keep closed seas (defined by closea_mask field) in the 
    9191      !                         !       domain and apply special treatment of freshwater fluxes. 
    92       !                         !  F => suppress closed seas (defined by closea_mask field)  
     92      !                         !  F => suppress closed seas (defined by closea_mask field) 
    9393      !                         !       from the bathymetry at runtime. 
    9494      !                         !  If closea_mask field doesn't exist in the domain_cfg file 
    … …  
    106106   ln_tsd_init = .false.         !  ocean initialisation 
    107107   ln_tsd_dmp  = .false.         !  T-S restoring   (see namtra_dmp) 
    108     
     108 
    109109   cn_dir      = './'      !  root directory for the T-S data location 
    110110   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    … …  
    195195   nn_fsbc     = 2         !  frequency of SBC module call 
    196196      !                    !  (control sea-ice & iceberg model call) 
    197                      ! Type of air-sea fluxes  
     197                     ! Type of air-sea fluxes 
    198198   ln_usr      = .false.   !  user defined formulation                  (T => check usrdef_sbc) 
    199199   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx ) 
    200200   ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk ) 
     201   ln_abl      = .false.   !  ABL  formulation                          (T => fill namsbc_abl ) 
    201202      !              ! Type of coupling (Ocean/Ice/Atmosphere) : 
    202203   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 ) 
    … …  
    205206      !                    !  =0 no opa-sas OASIS coupling: default single executable config. 
    206207      !                    !  =1 opa-sas OASIS coupling: multi executable config., OPA component 
    207       !                    !  =2 opa-sas OASIS coupling: multi executable config., SAS component  
     208      !                    !  =2 opa-sas OASIS coupling: multi executable config., SAS component 
    208209                     ! Sea-ice : 
    209    nn_ice      = 0         !  =0 no ice boundary condition     
     210   nn_ice      = 0         !  =0 no ice boundary condition 
    210211      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
    211212      !                    !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    … …  
    213214   ln_ice_embd = .false.   !  =T embedded sea-ice (pressure + mass and salt exchanges) 
    214215      !                    !  =F levitating ice (no pressure, mass and salt exchanges) 
    215                      ! Misc. options of sbc :  
     216                     ! Misc. options of sbc : 
    216217   ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_qsr) 
    217218   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    … …  
    225226   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave) 
    226227   ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 
    227    ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)  
     228   ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 
    228229   nn_sdrift   =  0        !  Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 
    229230      !                    !   = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    … …  
    250251/ 
    251252!----------------------------------------------------------------------- 
    252 &namsbc_blk    !   namsbc_blk  generic Bulk formula                     (ln_blk =T) 
     253&namsbc_blk    !   namsbc_blk  generic Bulk formula          (ln_blk =T) 
    253254!----------------------------------------------------------------------- 
    254255   !                    !  bulk algorithm : 
    255    ln_NCAR     = .false.   ! "NCAR"      algorithm   (Large and Yeager 2008) 
     256   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    256257   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    257    ln_COARE_3p5 = .false.   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    258    ln_ECMWF    = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     258   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     259   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    259260      ! 
    260       rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
    261       rn_zu       = 10.       !  Wind vector reference height (m) 
    262       ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
    263       ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
    264       ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    265       rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    266       rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    267       rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
    268       !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
    269  
     261      rn_zqt     = 10.      !  Air temperature & humidity reference height (m) 
     262      rn_zu      = 10.      !  Wind vector reference height (m) 
     263      ln_Cd_L12  = .false.  !  air-ice drags = F(ice conc.) (Lupkes et al. 2012) 
     264      ln_Cd_L15  = .false.  !  air-ice drags = F(ice conc.) (Lupkes et al. 2015) 
     265      !                     !  - module of the mean stress" data 
     266      rn_pfac    = 1.       !  multipl. factor for precipitation (total & snow) 
     267      rn_efac    = 1.       !  multipl. factor for evaporation (0. or 1.) 
     268      rn_vfac    = 0.       !  multipl. factor for ocean & ice velocity  
     269      !                     !  used to calculate the wind stress 
     270      !                     ! (0. => absolute or 1. => relative winds) 
     271      ln_skin_cs = .false.  !  use the cool-skin parameterization 
     272      ln_skin_wl = .false.  !  use the warm-layer parameterization 
     273      !                     !   ==> only available in ECMWF and COARE algorithms 
     274      ln_humi_sph = .true.  !  humidity "sn_humi" is specific humidity  [kg/kg] 
     275      ln_humi_dpt = .false. !  humidity "sn_humi" is dew-point temperature [K] 
     276      ln_humi_rlh = .false. !  humidity "sn_humi" is relative humidity     [%] 
     277   ! 
    270278   cn_dir      = './'      !  root directory for the bulk data location 
    271279   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    … …  
    278286   sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    279287   sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     288   sn_hpgi     = 'NONE'                       ,   24.        , 'uhpg'    ,   .false.   , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG'     , '' 
     289   sn_hpgj     = 'NONE'                       ,   24.        , 'vhpg'    ,   .false.   , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG'     , '' 
    280290   sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    281291   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    282292   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    283    sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     293/ 
     294!----------------------------------------------------------------------- 
     295&namsbc_abl    !   Atmospheric Boundary Layer formulation           (ln_abl = T) 
     296!----------------------------------------------------------------------- 
     297   cn_dir           = './'      !  root directory for the location of the ABL grid file 
     298   cn_dom           = 'dom_cfg_abl.nc' 
     299 
     300   cn_ablrst_in     = "restart_abl"   !  suffix of abl restart name (input) 
     301   cn_ablrst_out    = "restart_abl"   !  suffix of abl restart name (output) 
     302   cn_ablrst_indir  = "."             !  directory to read   input abl restarts 
     303   cn_ablrst_outdir = "."             !  directory to write output abl restarts 
     304 
     305   ln_hpgls_frc   = .false. 
     306   ln_geos_winds  = .false. 
     307   nn_dyn_restore = 2         ! restoring option for dynamical ABL variables: = 0 no restoring 
     308                              !                                               = 1 equatorial restoring 
     309                              !                                               = 2 global restoring 
     310   rn_ldyn_min   =  4.5       !  magnitude of the nudging on ABL dynamics at the bottom of the ABL   [hour] 
     311   rn_ldyn_max   =  1.5       !  magnitude of the nudging on ABL dynamics at the top of the ABL   [hour] 
     312   rn_ltra_min   =  4.5       !  magnitude of the nudging on ABL tracers  at the bottom of the ABL   [hour] 
     313   rn_ltra_max   =  1.5       !  magnitude of the nudging on ABL tracers  at the top of the ABL   [hour] 
     314   nn_amxl       =  0         ! mixing length: = 0 Deardorff 80 length-scale 
     315                              !                = 1 length-scale based on the distance to the PBL height 
     316                              !                = 2 Bougeault & Lacarrere 89 length-scale 
     317   rn_Cm         = 0.0667     ! 0.126 in MesoNH 
     318   rn_Ct         = 0.1667     ! 0.143 in MesoNH 
     319   rn_Ce         = 0.4        ! 0.4   in MesoNH 
     320   rn_Ceps       = 0.7        ! 0.85  in MesoNH 
     321   rn_Rod        = 0.15       ! c0 in RMCA17 mixing length formulation (not yet implemented) 
     322   rn_Ric        = 0.139      !  Critical Richardson number (to compute PBL height and diffusivities) 
    284323/ 
    285324!----------------------------------------------------------------------- 
    … …  
    375414   nn_chldta   =      0       !  RGB : Chl data (=1) or cst value (=0) 
    376415   rn_si1      =   23.0       !  2BD : longest depth of extinction 
    377     
     416 
    378417   cn_dir      = './'      !  root directory for the chlorophyl data location 
    379418   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    … …  
    443482/ 
    444483!----------------------------------------------------------------------- 
    445 &namsbc_isf    !  Top boundary layer (ISF)                              (ln_isfcav =T : read (ln_read_cfg=T)  
     484&namsbc_isf    !  Top boundary layer (ISF)                              (ln_isfcav =T : read (ln_read_cfg=T) 
    446485!-----------------------------------------------------------------------             or set or usr_def_zgr ) 
    447    !                 ! type of top boundary layer  
     486   !                 ! type of top boundary layer 
    448487   nn_isf      = 1         !  ice shelf melting/freezing 
    449                            !  1 = presence of ISF   ;  2 = bg03 parametrisation  
     488                           !  1 = presence of ISF   ;  2 = bg03 parametrisation 
    450489                           !  3 = rnf file for ISF  ;  4 = ISF specified freshwater flux 
    451490                           !  options 1 and 4 need ln_isfcav = .true. (domzgr) 
    … …  
    470509!* nn_isf = 3 case 
    471510   sn_rnfisf   = 'rnfisf'    ,         -12.      ,'sofwfisf' ,  .false.    , .true.  , 'yearly'  ,    ''    ,   ''     ,    '' 
    472 !* nn_isf = 2 and 3 cases  
     511!* nn_isf = 2 and 3 cases 
    473512   sn_depmax_isf ='rnfisf'   ,         -12.      ,'sozisfmax',  .false.    , .true.  , 'yearly'  ,    ''    ,   ''     ,    '' 
    474513   sn_depmin_isf ='rnfisf'   ,         -12.      ,'sozisfmin',  .false.    , .true.  , 'yearly'  ,    ''    ,   ''     ,    '' 
    … …  
    477516/ 
    478517!----------------------------------------------------------------------- 
    479 &namsbc_iscpl  !   land ice / ocean coupling option                     (ln_isfcav =T : read (ln_read_cfg=T)  
     518&namsbc_iscpl  !   land ice / ocean coupling option                     (ln_isfcav =T : read (ln_read_cfg=T) 
    480519!-----------------------------------------------------------------------             or set or usr_def_zgr ) 
    481520   nn_drown    = 10        ! number of iteration of the extrapolation loop (fill the new wet cells) 
    … …  
    572611!----------------------------------------------------------------------- 
    573612   ln_tide     = .false.      ! Activate tides 
    574       ln_tide_pot   = .true.                !  use tidal potential forcing 
     613      ln_tide_pot   = .false.               !  use tidal potential forcing 
    575614         ln_scal_load  = .false.               ! Use scalar approximation for 
    576615            rn_scal_load = 0.094               !     load potential 
    577616         ln_read_load  = .false.               ! Or read load potential from file 
    578617            cn_tide_load = 'tide_LOAD_grid_T.nc'  ! filename for load potential 
    579             !       
     618            ! 
    580619      ln_tide_ramp  = .false.               !  Use linear ramp for tides at startup 
    581620         rdttideramp   =    0.                 !  ramp duration in days 
    … …  
    656695   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files 
    657696   ln_bdytide_2ddta = .false.                   ! 
    658    ln_bdytide_conj  = .false.                   !  
     697   ln_bdytide_conj  = .false.                   ! 
    659698/ 
    660699 
    … …  
    683722!----------------------------------------------------------------------- 
    684723   rn_Cd0      =  1.e-3    !  drag coefficient [-] 
    685    rn_Uc0      =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)  
     724   rn_Uc0      =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0) 
    686725   rn_Cdmax    =  0.1      !  drag value maximum [-] (logarithmic drag) 
    687726   rn_ke0      =  2.5e-3   !  background kinetic energy  [m2/s2] (non-linear cases) 
    … …  
    694733!----------------------------------------------------------------------- 
    695734   rn_Cd0      =  1.e-3    !  drag coefficient [-] 
    696    rn_Uc0      =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0)  
     735   rn_Uc0      =  0.4      !  ref. velocity [m/s] (linear drag=Cd0*Uc0) 
    697736   rn_Cdmax    =  0.1      !  drag value maximum [-] (logarithmic drag) 
    698737   rn_ke0      =  2.5e-3   !  background kinetic energy  [m2/s2] (non-linear cases) 
    … …  
    761800      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
    762801   ln_traadv_fct = .false. !  FCT scheme 
    763       nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order  
    764       nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order  
     802      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
     803      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    765804   ln_traadv_mus = .false. !  MUSCL scheme 
    766805      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    783822   ln_traldf_triad = .false.   !  iso-neutral (triad    operator) 
    784823   ! 
    785    !                       !  iso-neutral options:         
     824   !                       !  iso-neutral options: 
    786825   ln_traldf_msc   = .false.   !  Method of Stabilizing Correction      (both operators) 
    787826   rn_slpmax       =  0.01     !  slope limit                           (both operators) 
    … …  
    793832   nn_aht_ijk_t    = 0         !  space/time variation of eddy coefficient: 
    794833      !                             !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file 
    795       !                             !   =  0           constant  
    796       !                             !   = 10 F(k)      =ldf_c1d  
    797       !                             !   = 20 F(i,j)    =ldf_c2d  
     834      !                             !   =  0           constant 
     835      !                             !   = 10 F(k)      =ldf_c1d 
     836      !                             !   = 20 F(i,j)    =ldf_c2d 
    798837      !                             !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
    799838      !                             !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d 
    800839      !                             !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing) 
    801       !                        !  time invariant coefficients:  aht0 = 1/2  Ud*Ld   (lap case)  
     840      !                        !  time invariant coefficients:  aht0 = 1/2  Ud*Ld   (lap case) 
    802841      !                             !                           or   = 1/12 Ud*Ld^3 (blp case) 
    803842      rn_Ud        = 0.01           !  lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 
    … …  
    825864      nn_aei_ijk_t    = 0           !  space/time variation of eddy coefficient: 
    826865      !                             !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
    827       !                             !   =  0           constant  
    828       !                             !   = 10 F(k)      =ldf_c1d  
    829       !                             !   = 20 F(i,j)    =ldf_c2d  
     866      !                             !   =  0           constant 
     867      !                             !   = 10 F(k)      =ldf_c1d 
     868      !                             !   = 20 F(i,j)    =ldf_c2d 
    830869      !                             !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
    831870      !                             !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d 
    832       !                        !  time invariant coefficients:  aei0 = 1/2  Ue*Le  
     871      !                        !  time invariant coefficients:  aei0 = 1/2  Ue*Le 
    833872      rn_Ue        = 0.02           !  lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 
    834873      rn_Le        = 200.e+3        !  lateral diffusive length   [m]   (nn_aht_ijk_t= 0, 10) 
    … …  
    870909   rn_lf_cutoff  =  5.0             !  cutoff frequency for low-pass filter  [days] 
    871910   rn_zdef_max   =  0.9             !  maximum fractional e3t deformation 
    872    ln_vvl_dbg    = .true.           !  debug prints    (T/F) 
     911   ln_vvl_dbg    = .false.          !  debug prints    (T/F) 
    873912/ 
    874913!----------------------------------------------------------------------- 
    … …  
    890929   ln_dynvor_eeT = .false. !  energy conserving scheme (een using e3t) 
    891930   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    892       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4  
     931      nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4 
    893932      !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    894933   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T)        ==>>> PLEASE DO NOT ACTIVATE 
    … …  
    935974      !                             !  =-30  read in eddy_viscosity_3D.nc file 
    936975      !                             !  =-20  read in eddy_viscosity_2D.nc file 
    937       !                             !  =  0  constant  
     976      !                             !  =  0  constant 
    938977      !                             !  = 10  F(k)=c1d 
    939978      !                             !  = 20  F(i,j)=F(grid spacing)=c2d 
    … …  
    941980      !                             !  = 31  F(i,j,k)=F(grid spacing and local velocity) 
    942981      !                             !  = 32  F(i,j,k)=F(local gridscale and deformation rate) 
    943       !                        !  time invariant coefficients :  ahm = 1/2  Uv*Lv   (lap case)  
     982      !                        !  time invariant coefficients :  ahm = 1/2  Uv*Lv   (lap case) 
    944983      !                             !                            or  = 1/12 Uv*Lv^3 (blp case) 
    945984      rn_Uv      = 0.1              !  lateral viscous velocity [m/s] (nn_ahm_ijk_t= 0, 10, 20, 30) 
    … …  
    10651104                              !        = 0  constant 10 m length scale 
    10661105                              !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
    1067       rn_eice     =   4       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4    
     1106      rn_eice     =   4       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4 
    10681107/ 
    10691108!----------------------------------------------------------------------- 
    … …  
    13231362   ln_ctl = .FALSE.                 ! Toggle all report printing on/off (T/F); Ignored if sn_cfctl%l_config is T 
    13241363     sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the following 
    1325        sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings. 
     1364       sn_cfctl%l_runstat = .TRUE. ! switches and which areas produce reports with the proc integer settings. 
    13261365       sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 
    13271366       sn_cfctl%l_oceout  = .FALSE. ! that  all areas report. 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/SPITZ12/EXPREF/namelist_cfg

    r11536 r12154  
    107107   sn_snow     = 'MARv3.6-9km-Svalbard-2hourly_spitz' ,  2. ,  'snow'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin', '' , '' 
    108108   sn_slp      = 'MARv3.6-9km-Svalbard-2hourly_spitz' ,  2. ,  'slp'     ,   .true.    , .false. , 'yearly'  , 'weights_bilin', '' , '' 
    109    sn_tdif     = 'MARv3.6-9km-Svalbard-2hourly_spitz' ,  2. ,  'tdif'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin', '' , '' 
    110109/ 
    111110!----------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/cfgs/ref_cfgs.txt

    r9775 r12154  
    88ORCA2_SAS_ICE OCE ICE NST SAS 
    99ORCA2_ICE_PISCES OCE TOP ICE NST 
     10ORCA2_ICE_ABL OCE ICE ABL 
     11ORCA2_SAS_ICE_ABL OCE SAS ICE ABL 
     12ORCA2_ICE OCE ICE 
    1013SPITZ12 OCE ICE 
     14eORCA025_ICE OCE ICE 
     15eORCA025_ICE_ABL OCE ICE ABL 
     16eORCA025_SAS_ICE_ABL OCE SAS ICE ABL 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/ABL/ablmod.F90

    r11937 r12154  
    1717   USE phycst         ! physical constants 
    1818   USE dom_oce, ONLY  : tmask   
    19    USE sbc_oce, ONLY  : ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 
    20    USE sbcblk         ! use some physical constants for flux computation 
     19   USE sbc_oce, ONLY  : ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1, rhoa 
     20   USE sbcblk         ! use rn_?fac 
     21   USE sbcblk_phy     ! use some physical constants for flux computation 
    2122   ! 
    2223   USE prtctl         ! Print control                    (prt_ctl routine) 
    … …  
    100101      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj_ice    ! ice-surface tauy stress (V-point)      
    101102#endif      
    102      ! 
    103       REAL(wp), DIMENSION(1:jpi,1:jpj   )        ::   zrhoa, zwnd_i, zwnd_j 
     103      ! 
     104      REAL(wp), DIMENSION(1:jpi,1:jpj   )        ::   zwnd_i, zwnd_j 
    104105      REAL(wp), DIMENSION(1:jpi,2:jpka  )        ::   zCF     
    105106      REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka)    ::   z_cft      !--FL--to be removed after the test phase    
    … …  
    529530            ztemp             = tq_abl  ( ji, jj, 2, nt_a, jp_ta )  
    530531            zhumi             = tq_abl  ( ji, jj, 2, nt_a, jp_qa )  
    531             zcff              = pslp_dta( ji, jj ) /   &              !<-- At this point ztemp and zhumi should not be zero ... 
    532                &                        (  R_dry*ztemp * ( 1._wp + rctv0*zhumi )  ) 
     532            !zcff              = pslp_dta( ji, jj ) /   &              !<-- At this point ztemp and zhumi should not be zero ... 
     533            !   &                        (  R_dry*ztemp * ( 1._wp + rctv0*zhumi )  ) 
     534            zcff              = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 
    533535            psen ( ji, jj )   =      cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp ) 
    534536            pevp ( ji, jj )   = rn_efac*MAX( 0._wp,  zcff * pevp(ji,jj) * ( pssq(ji,jj)       - zhumi ) ) 
    535             zrhoa( ji, jj )   = zcff               
     537            rhoa( ji, jj )   = zcff               
    536538         END DO 
    537539      END DO 
    … …  
    551553            zcff          = SQRT(  zwnd_i(ji,jj) * zwnd_i(ji,jj)   & 
    552554               &                 + zwnd_j(ji,jj) * zwnd_j(ji,jj)  )  ! * msk_abl(ji,jj) 
    553             zztmp         = zrhoa(ji,jj) * pcd_du(ji,jj) 
     555            zztmp         = rhoa(ji,jj) * pcd_du(ji,jj) 
    554556             
    555557            pwndm (ji,jj) =         zcff 
    … …  
    593595               zztmp2 = 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 
    594596             
    595                ptaui_ice(ji,jj) = 0.5_wp * (  zrhoa(ji+1,jj) * pCd_du_ice(ji+1,jj)             & 
    596                   &                      +    zrhoa(ji  ,jj) * pCd_du_ice(ji  ,jj)  )          & 
     597               ptaui_ice(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj)             & 
     598                  &                      +    rhoa(ji  ,jj) * pCd_du_ice(ji  ,jj)  )          & 
    597599                  &         * ( zztmp1 - rn_vfac * pssu_ice(ji,jj) ) 
    598                ptauj_ice(ji,jj) = 0.5_wp * (  zrhoa(ji,jj+1) * pCd_du_ice(ji,jj+1)             & 
    599                   &                      +    zrhoa(ji,jj  ) * pCd_du_ice(ji,jj  )  )          & 
     600               ptauj_ice(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1)             & 
     601                  &                      +    rhoa(ji,jj  ) * pCd_du_ice(ji,jj  )  )          & 
    600602                  &         * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) ) 
    601603            END DO 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/ABL/sbcabl.F90

    r11858 r12154  
    2222   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2323   USE sbcblk         ! Surface boundary condition: bulk formulae 
     24   USE sbcblk_phy     ! Surface boundary condition: bulk formulae 
    2425   USE dom_oce, ONLY  : tmask 
    2526   ! 
    … …  
    9394      IF( nn_dyn_restore  < 0   .OR.  nn_dyn_restore  > 2 )   & 
    9495         &                 CALL ctl_stop( 'abl_init : bad flag, nn_dyn_restore must be  0, 1 or 2 ' )             
    95       ! 
     96 
    9697      !!--------------------------------------------------------------------- 
    9798      !! Control prints 
    … …  
    215216            WRITE(numout,*) ' ABL Maximum value for dynamics restoring = ',zcff1 
    216217            ! Check that restoring coefficients are between 0 and 1 
    217             !IF( zcff1 > 1._wp .OR. zcff1 < 0._wp )   & 
    218             !IF( zcff1 > nn_fsbc .OR. zcff1 < 0._wp )   & 
    219218            IF( zcff1 - nn_fsbc > 0.001_wp .OR. zcff1 < 0._wp )   & 
    220219               &                   CALL ctl_stop( 'abl_init : wrong value for rn_ldyn_max' ) 
    221             !IF( zcff  > 1._wp .OR. zcff  < 0._wp )   & 
    222220            IF( zcff  - nn_fsbc > 0.001_wp .OR. zcff  < 0._wp )   & 
    223221               &                   CALL ctl_stop( 'abl_init : wrong value for rn_ldyn_min' ) 
    … …  
    236234         WRITE(numout,*) ' ABL Maximum value for tracers restoring = ',zcff1 
    237235         ! Check that restoring coefficients are between 0 and 1 
    238          !IF( zcff1 > 1._wp .OR. zcff1 < 0._wp )   & 
    239236         IF( zcff1 - nn_fsbc > 0.001_wp .OR. zcff1 < 0._wp )   & 
    240237            &                   CALL ctl_stop( 'abl_init : wrong value for rn_ltra_max' ) 
    241          !IF( zcff  > 1._wp .OR. zcff  < 0._wp )   & 
    242238         IF( zcff  - nn_fsbc > 0.001_wp .OR. zcff  < 0._wp )   & 
    243239            &                   CALL ctl_stop( 'abl_init : wrong value for rn_ltra_min' ) 
    … …  
    294290         tke_abl(:,:,:,nt_a     ) = 0._wp 
    295291      ENDIF 
     292 
     293      rhoa(:,:) = rho_air( tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), sf(jp_slp)%fnow(:,:,1) ) !!GS: rhoa must be (re)computed here here to avoid division by zero in blk_ice_1 (TBI) 
    296294      
    297295   END SUBROUTINE sbc_abl_init 
    … …  
    341339         &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
    342340         &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
     341         &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
    343342         &                zssq, zcd_du, zsen, zevp                          )       !   =>> out 
    344343   

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/ICE/icesbc.F90

    r11575 r12154  
    2727   USE lbclnk         ! lateral boundary conditions (or mpp links) 
    2828   USE timing         ! Timing 
     29   USE fldread        !!GS: needed by agrif 
    2930 
    3031   IMPLICIT NONE 
    … …  
    7172      SELECT CASE( ksbc ) 
    7273         CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    73          CASE( jp_blk     )   ;    CALL blk_ice_tau                              ! Bulk         formulation 
     74         CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
     75            &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   & 
     76            &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs 
     77            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                              
     78 !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
    7479         CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
    7580      END SELECT 
    … …  
    143148      CASE( jp_usr )              !--- user defined formulation 
    144149                                  CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
    145       CASE( jp_blk )              !--- bulk formulation 
    146                                   CALL blk_ice_flx    ( t_su, h_s, h_i, alb_ice )    !  
     150      CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation 
     151                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    & 
     152            &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    !  
    147153         IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    148154         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/ICE/icevar.F90

    r11732 r12154  
    115115      ! 
    116116      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
    117  
     117      ! 
     118      !!GS: tm_su always needed by ABL over sea-ice 
     119      ALLOCATE( z1_at_i(jpi,jpj) ) 
     120      WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:) 
     121      ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp 
     122      END WHERE 
     123      tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
     124      WHERE( at_i(:,:)<=epsi20 ) tm_su(:,:) = rt0 
     125      ! 
    118126      ! The following fields are calculated for diagnostics and outputs only 
    119127      ! ==> Do not use them for other purposes 
    120128      IF( kn > 1 ) THEN 
    121129         ! 
    122          ALLOCATE( z1_at_i(jpi,jpj) , z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 
    123          WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:) 
    124          ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp 
    125          END WHERE 
     130         ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 
    126131         WHERE( vt_i(:,:) > epsi20 )   ;   z1_vt_i(:,:) = 1._wp / vt_i(:,:) 
    127132         ELSEWHERE                     ;   z1_vt_i(:,:) = 0._wp 
    … …  
    136141         !          
    137142         !                          ! mean temperature (K), salinity and age 
    138          tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    139143         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    140144         om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:) 
    … …  
    154158         !                           ! put rt0 where there is no ice 
    155159         WHERE( at_i(:,:)<=epsi20 ) 
    156             tm_su(:,:) = rt0 
    157160            tm_si(:,:) = rt0 
    158161            tm_i (:,:) = rt0 
    … …  
    165168         END WHERE          
    166169         ! 
    167          DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 
     170         DEALLOCATE( z1_vt_i , z1_vt_s ) 
    168171         ! 
    169172      ENDIF 
     173      ! 
     174      DEALLOCATE( z1_at_i ) 
    170175      ! 
    171176   END SUBROUTINE ice_var_agg 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DIA/diawri.F90

    r11536 r12154  
    2626   !!---------------------------------------------------------------------- 
    2727   USE oce            ! ocean dynamics and tracers  
     28   USE abl            ! abl variables in case ln_abl = .true. 
    2829   USE dom_oce        ! ocean space and time domain 
    2930   USE phycst         ! physical constants 
    … …  
    6667   PUBLIC   dia_wri_state 
    6768   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    68  
     69#if ! defined key_iomput    
     70   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.) 
     71#endif 
    6972   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    7073   INTEGER ::          nb_T              , ndim_bT   ! grid_T file 
    … …  
    7275   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
    7376   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
     77   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file    
    7478   INTEGER ::   ndex(1)                              ! ??? 
    7579   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
     80   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
    7681   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
    7782   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 
    … …  
    414419         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
    415420         ! 
    416       dia_wri_alloc = MAXVAL(ierr) 
     421     dia_wri_alloc = MAXVAL(ierr) 
    417422      CALL mpp_sum( 'diawri', dia_wri_alloc ) 
    418423      ! 
    419424   END FUNCTION dia_wri_alloc 
    420  
    421     
     425  
     426   INTEGER FUNCTION dia_wri_alloc_abl() 
     427      !!---------------------------------------------------------------------- 
     428     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 
     429      CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 
     430      ! 
     431   END FUNCTION dia_wri_alloc_abl 
     432  
    422433   SUBROUTINE dia_wri( kt ) 
    423434      !!--------------------------------------------------------------------- 
    … …  
    440451      INTEGER  ::   ierr                                     ! error code return from allocation 
    441452      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     453      INTEGER  ::   ipka                                     ! ABL 
    442454      INTEGER  ::   jn, ierror                               ! local integers 
    443455      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
    … …  
    445457      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace 
    446458      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace 
     459      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    447460      !!---------------------------------------------------------------------- 
    448461      ! 
    … …  
    478491      ijmi = 1      ;      ijma = jpj 
    479492      ipk = jpk 
     493      IF(ln_abl) ipka = jpkam1 
    480494 
    481495      ! define time axis 
    … …  
    580594            &          "m", ipk, gdepw_1d, nz_W, "down" ) 
    581595 
     596         IF( ln_abl ) THEN  
     597         ! Define the ABL grid FILE ( nid_A ) 
     598            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
     599            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
     600            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     601               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
     602               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 
     603            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept 
     604               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 
     605            !                                                            ! Index of ocean points 
     606         ALLOCATE( zw3d_abl(jpi,jpj,ipka) )  
     607         zw3d_abl(:,:,:) = 1._wp  
     608         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume 
     609            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface 
     610         DEALLOCATE(zw3d_abl) 
     611         ENDIF 
    582612 
    583613         ! Declare all the output fields as NETCDF variables 
    … …  
    629659         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    630660            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    631 ! 
     661         ! 
     662         IF( ln_abl ) THEN 
     663            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl 
     664               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     665            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl 
     666               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     667            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl 
     668               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     669            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl 
     670               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     671            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl 
     672               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     673            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl 
     674               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     675            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl 
     676               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     677            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh 
     678               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                  
     679#if defined key_si3 
     680            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i 
     681               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout ) 
     682#endif 
     683            CALL histend( nid_A, snc4chunks=snc4set ) 
     684         ENDIF 
     685         ! 
    632686         IF( ln_icebergs ) THEN 
    633687            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , & 
    … …  
    787841      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    788842      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
    789 ! 
     843      ! 
     844      IF( ln_abl ) THEN  
     845         ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 
     846         IF( ln_mskland )   THEN  
     847            DO jk=1,jpka 
     848               zw3d_abl(:,:,jk) = tmask(:,:,1) 
     849            END DO        
     850         ELSE 
     851            zw3d_abl(:,:,:) = 1._wp      
     852         ENDIF        
     853         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh  
     854         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl 
     855         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl 
     856         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl 
     857         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl        
     858         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl 
     859         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl 
     860         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl  
     861#if defined key_si3 
     862         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i 
     863#endif 
     864         DEALLOCATE(zw3d_abl) 
     865      ENDIF 
     866      ! 
    790867      IF( ln_icebergs ) THEN 
    791868         ! 
    … …  
    857934         CALL histclo( nid_V ) 
    858935         CALL histclo( nid_W ) 
     936         IF(ln_abl) CALL histclo( nid_A ) 
    859937      ENDIF 
    860938      ! 
    … …  
    9261004         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
    9271005      ENDIF 
     1006      IF ( ln_abl ) THEN 
     1007         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind 
     1008         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind 
     1009         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature 
     1010         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
     1011      ENDIF 
    9281012  
    9291013#if defined key_si3 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/IOM/in_out_manager.F90

    r11536 r12154  
    8787   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    8888   LOGICAL ::   lrst_ice              !: logical to control the ice restart write  
     89   LOGICAL ::   lrst_abl              !: logical to control the abl restart write  
    8990   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
    9091   INTEGER ::   numrir                !: logical unit for ice   restart (read) 
     92   INTEGER ::   numrar                !: logical unit for abl   restart (read) 
    9193   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
    9294   INTEGER ::   numriw                !: logical unit for ice   restart (write) 
     95   INTEGER ::   numraw                !: logical unit for abl   restart (write) 
    9396   INTEGER ::   nrst_lst              !: number of restart to output next 
    9497 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/IOM/iom.F90

    r12109 r12154  
    2929   USE lib_mpp           ! MPP library 
    3030#if defined key_iomput 
    31    USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain 
     31   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 
    3232   USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    3333   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes 
    … …  
    113113      ! 
    114114      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
     115      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    115116      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    116117      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
    … …  
    200201      ! vertical grid definition 
    201202      IF(.NOT.llrst_context) THEN 
    202           CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d ) 
    203           CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d ) 
    204           CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d ) 
    205           CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d ) 
    206  
     203          CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d ) 
     204          CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d ) 
     205          CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d ) 
     206          CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d ) 
     207 
     208          ! ABL 
     209          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios)  
     210             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom 
     211             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp 
     212             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp 
     213          ENDIF 
     214          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 
     215          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 
     216           
    207217          ! Add vertical grid bounds 
    208218          jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    … …  
    213223          zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    214224          zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    215           CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 
    216           CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 
    217           CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 
    218           CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 
     225          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
     226          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
     227          CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds ) 
     228          CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds ) 
     229 
     230          ! ABL 
     231          za_bnds(1,:) = ghw_abl(1:jpkam1) 
     232          za_bnds(2,:) = ghw_abl(2:jpka  ) 
     233          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 
     234          za_bnds(1,:) = ght_abl(2:jpka  ) 
     235          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka) 
     236          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 
     237 
    219238          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 
    220239# if defined key_si3 
    … …  
    11471166            WRITE(cldmspc , fmt='(i1)') idmspc 
    11481167            ! 
    1149             IF(     idmspc <  irankpv ) THEN  
    1150                CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1151                   &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    1152             ELSEIF( idmspc == irankpv ) THEN 
     1168            !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1169            !IF(     idmspc <  irankpv ) THEN  
     1170            !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1171            !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
     1172            !ELSEIF( idmspc == irankpv ) THEN 
     1173            IF( idmspc == irankpv ) THEN 
    11531174               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    11541175                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
    … …  
    19721993      ! 
    19731994      INTEGER :: ji, jj, jn, ni, nj 
    1974       INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1975       !                                                        ! represents the bottom-left corner of cell (i,j) 
     1995      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     1996      !                                                 ! represents the bottom-left corner of cell (i,j) 
    19761997      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    19771998      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
    … …  
    21432164      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
    21442165      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
     2166      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of) 
    21452167      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
    21462168      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/IOM/iom_nf90.F90

    r11536 r12154  
    1919   !!---------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
     21   USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height 
    2122   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2223   USE iom_def         ! iom variables definitions 
    … …  
    5657      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    5758      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    58       INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension 
     59      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
    5960 
    6061      CHARACTER(LEN=256) ::   clinfo           ! info character 
    … …  
    6970      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7071      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    71       INTEGER            ::   ilevels           ! vertical levels 
     72      INTEGER            ::   ilevels          ! vertical levels 
    7273      !--------------------------------------------------------------------- 
    7374      ! 
    … …  
    7677      ! 
    7778      !                 !number of vertical levels 
    78       IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice) 
    79       ELSE                        ;   ilevels = jpk      ! by default jpk 
     79      IF( PRESENT(kdlev) )   THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice and abl) 
     80      ELSE                          ;   ilevels = jpk      ! by default jpk 
    8081      ENDIF 
    8182      ! 
    … …  
    126127            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    127128            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    129             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    130             IF( PRESENT(kdlev) )   & 
    131                CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo) 
     129            IF( PRESENT(kdlev) ) THEN 
     130              IF( kdlev == jpka ) THEN 
     131                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',          kdlev, idmy ), clinfo) 
     132                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     133              ELSE 
     134                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
     135                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     136                 CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo) 
     137              ENDIF 
     138            ELSE 
     139               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
     140               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     141            ENDIF 
    132142            ! global attributes 
    133143            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    … …  
    196206      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    197207      INTEGER              , INTENT(in   )           ::   kiv   !  
    198       INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
    199       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     208      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
     209      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
    200210      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    201211      ! 
    … …  
    584594         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    585595         ELSEIF( PRESENT(pv_r1d) ) THEN 
    586             IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3 
    587             ELSE                               ;   idim3 = 5 
     596            IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN   ;   idim3 = 3 
     597            ELSE                                                               ;   idim3 = 5 
    588598            ENDIF 
    589599                                              idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    590600         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
    591601         ELSEIF( PRESENT(pv_r3d) ) THEN 
    592             IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3 
    593             ELSE                               ;   idim3 = 5 
     602            IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN   ;   idim3 = 3 
     603            ELSE                                                               ;   idim3 = 5 
    594604            ENDIF 
    595605                                              idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
    … …  
    674684               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    675685               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo ) 
    676                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo ) 
     686               IF (iom_file(kiomid)%nlev == jpka) THEN   ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy,  ght_abl), clinfo ) 
     687               ELSE                                      ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d), clinfo ) 
     688               ENDIF 
    677689               IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 
    678690                  CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/cpl_oasis3.F90

    r10582 r12154  
    114114      !------------------------------------------------------------------ 
    115115      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 
    116       IF ( nerror /= OASIS_Ok ) & 
     116      IF( nerror /= OASIS_Ok ) & 
    117117         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    118118 
    … …  
    122122 
    123123      CALL oasis_get_localcomm ( kl_comm, nerror ) 
    124       IF ( nerror /= OASIS_Ok ) & 
     124      IF( nerror /= OASIS_Ok ) & 
    125125         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
    126126      ! 
    … …  
    149149 
    150150      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    151       IF ( ltmp_wapatch ) THEN 
     151      IF( ltmp_wapatch ) THEN 
    152152         nldi_save = nldi   ;   nlei_save = nlei 
    153153         nldj_save = nldj   ;   nlej_save = nlej 
    … …  
    217217      ! 
    218218      DO ji = 1, ksnd 
    219          IF ( ssnd(ji)%laction ) THEN 
     219         IF( ssnd(ji)%laction ) THEN 
    220220 
    221221            IF( ssnd(ji)%nct > nmaxcat ) THEN 
    … …  
    228228               DO jm = 1, kcplmodel 
    229229 
    230                   IF ( ssnd(ji)%nct .GT. 1 ) THEN 
     230                  IF( ssnd(ji)%nct .GT. 1 ) THEN 
    231231                     WRITE(cli2,'(i2.2)') jc 
    232232                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 
    … …  
    234234                     zclname = ssnd(ji)%clname 
    235235                  ENDIF 
    236                   IF ( kcplmodel  > 1 ) THEN 
     236                  IF( kcplmodel  > 1 ) THEN 
    237237                     WRITE(cli2,'(i2.2)') jm 
    238238                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
    … …  
    241241                  IF( agrif_fixed() /= 0 ) THEN  
    242242                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    243                   END IF 
     243                  ENDIF 
    244244#endif 
    245245                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 
    246246                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    247247                     &                OASIS_Out          , ishape , OASIS_REAL, nerror ) 
    248                   IF ( nerror /= OASIS_Ok ) THEN 
     248                  IF( nerror /= OASIS_Ok ) THEN 
    249249                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
    250250                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
    … …  
    262262      ! 
    263263      DO ji = 1, krcv 
    264          IF ( srcv(ji)%laction ) THEN  
     264         IF( srcv(ji)%laction ) THEN  
    265265             
    266266            IF( srcv(ji)%nct > nmaxcat ) THEN 
    … …  
    273273               DO jm = 1, kcplmodel 
    274274                   
    275                   IF ( srcv(ji)%nct .GT. 1 ) THEN 
     275                  IF( srcv(ji)%nct .GT. 1 ) THEN 
    276276                     WRITE(cli2,'(i2.2)') jc 
    277277                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 
    … …  
    279279                     zclname = srcv(ji)%clname 
    280280                  ENDIF 
    281                   IF ( kcplmodel  > 1 ) THEN 
     281                  IF( kcplmodel  > 1 ) THEN 
    282282                     WRITE(cli2,'(i2.2)') jm 
    283283                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
    … …  
    286286                  IF( agrif_fixed() /= 0 ) THEN  
    287287                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    288                   END IF 
     288                  ENDIF 
    289289#endif 
    290290                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
    291291                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    292292                     &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
    293                   IF ( nerror /= OASIS_Ok ) THEN 
     293                  IF( nerror /= OASIS_Ok ) THEN 
    294294                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
    295295                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
    … …  
    310310      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
    311311      ! 
    312       IF ( ltmp_wapatch ) THEN 
     312      IF( ltmp_wapatch ) THEN 
    313313         nldi = nldi_save   ;   nlei = nlei_save 
    314314         nldj = nldj_save   ;   nlej = nlej_save 
    … …  
    332332      !!-------------------------------------------------------------------- 
    333333      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    334       IF ( ltmp_wapatch ) THEN 
     334      IF( ltmp_wapatch ) THEN 
    335335         nldi_save = nldi   ;   nlei_save = nlei 
    336336         nldj_save = nldj   ;   nlej_save = nlej 
    … …  
    349349               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
    350350                
    351                IF ( ln_ctl ) THEN         
    352                   IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
     351               IF( ln_ctl ) THEN         
     352                  IF( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
    353353                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
    354354                     WRITE(numout,*) '****************' 
    … …  
    368368         ENDDO 
    369369      ENDDO 
    370       IF ( ltmp_wapatch ) THEN 
     370      IF( ltmp_wapatch ) THEN 
    371371         nldi = nldi_save   ;   nlei = nlei_save 
    372372         nldj = nldj_save   ;   nlej = nlej_save 
    … …  
    393393      !!-------------------------------------------------------------------- 
    394394      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    395       IF ( ltmp_wapatch ) THEN 
     395      IF( ltmp_wapatch ) THEN 
    396396         nldi_save = nldi   ;   nlei_save = nlei 
    397397         nldj_save = nldj   ;   nlej_save = nlej 
    … …  
    403403      ! 
    404404      DO jc = 1, srcv(kid)%nct 
    405          IF ( ltmp_wapatch ) THEN 
     405         IF( ltmp_wapatch ) THEN 
    406406            IF( nimpp           ==      1 ) nldi = 1 
    407407            IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    … …  
    420420                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    421421                
    422                IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     422               IF( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    423423                
    424                IF ( llaction ) THEN 
     424               IF( llaction ) THEN 
    425425                   
    426426                  kinfo = OASIS_Rcv 
    … …  
    432432                  ENDIF 
    433433                   
    434                   IF ( ln_ctl ) THEN         
     434                  IF( ln_ctl ) THEN         
    435435                     WRITE(numout,*) '****************' 
    436436                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
    … …  
    450450         ENDDO 
    451451 
    452          IF ( ltmp_wapatch ) THEN 
     452         IF( ltmp_wapatch ) THEN 
    453453            nldi = nldi_save   ;   nlei = nlei_save 
    454454            nldj = nldj_save   ;   nlej = nlej_save 
    … …  
    483483      ! 
    484484      DO ji = 1, nsnd 
    485          IF (ssnd(ji)%laction ) THEN 
     485         IF(ssnd(ji)%laction ) THEN 
    486486            DO jm = 1, ncplmodel 
    487487               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
    … …  
    495495      ENDDO 
    496496      DO ji = 1, nrcv 
    497          IF (srcv(ji)%laction ) THEN 
     497         IF(srcv(ji)%laction ) THEN 
    498498            DO jm = 1, ncplmodel 
    499499               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
    … …  
    529529      ! 
    530530      DEALLOCATE( exfld ) 
    531       IF (nstop == 0) THEN 
     531      IF(nstop == 0) THEN 
    532532         CALL oasis_terminate( nerror )          
    533533      ELSE 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/cyclone.F90

    r10068 r12154  
    137137            zhemi = SIGN( 1. , zrlat ) 
    138138            zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones 
    139          IF ( vortex == 0 ) THEN 
     139         IF( vortex == 0 ) THEN 
    140140 
    141141            ! Vortex Holland reconstruct wind at each lon-lat position 
    … …  
    157157                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 
    158158 
    159                  IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius 
     159                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 
    160160                  ! shape of the wind profile 
    161161                  zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb 
    162162                  zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )     
    163163 
    164                   IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
     164                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
    165165                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 
    166166                  ENDIF 
    167167 
    168168                  ! !!! KILL EQ WINDS 
    169                   ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN 
     169                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 
    170170                  !    zztmp = 0.                              ! winds in other hemisphere 
    171                   !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
    172                   ! ENDIF 
    173                   ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
     171                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
     172                  ! ENDIF 
     173                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
    174174                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) )  
    175175                  !    !linear to zero between 10 and 5 
    … …  
    177177                  ! !!! / KILL EQ 
    178178 
    179                   IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
     179                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
    180180 
    181181                  zwnd_t =   COS( zinfl ) * zztmp     
    … …  
    196196            END DO 
    197197          
    198          ELSE IF ( vortex == 1 ) THEN 
     198         ELSE IF( vortex == 1 ) THEN 
    199199 
    200200            ! Vortex Willoughby reconstruct wind at each lon-lat position 
    … …  
    206206            zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )             
    207207            zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )   
    208             IF (zA < 0) THEN  
     208            IF(zA < 0) THEN  
    209209               zA=0 
    210210            ENDIF            
    … …  
    218218                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 
    219219 
    220                  IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius 
     220                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 
    221221                
    222222                  ! shape of the wind profile                      
    223                   IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind 
     223                  IF(zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind 
    224224                     zztmp  = zvmax * (zdist/zrmw)**zn 
    225225                  ELSE  
    … …  
    227227                  ENDIF 
    228228 
    229                   IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
     229                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
    230230                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 
    231231                  ENDIF 
    232232 
    233233                  ! !!! KILL EQ WINDS 
    234                   ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN 
     234                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 
    235235                  !    zztmp = 0.                              ! winds in other hemisphere 
    236                   !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
    237                   ! ENDIF 
    238                   ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
     236                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
     237                  ! ENDIF 
     238                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
    239239                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) )  
    240240                  !    !linear to zero between 10 and 5 
    … …  
    242242                  ! !!! / KILL EQ 
    243243 
    244                   IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
     244                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
    245245 
    246246                  zwnd_t =   COS( zinfl ) * zztmp     

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/fldread.F90

    r11536 r12154  
    167167      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    168168 
    169       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     169      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    170170      ELSE                                      ;   it_offset = 0 
    171171      ENDIF 
    … …  
    389389         ENDIF 
    390390         ! 
    391          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     391         IF( sdjf%cltype(1:4) == 'week' ) THEN 
    392392            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week 
    393393            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month 
    … …  
    464464      ENDIF 
    465465      ! 
    466       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     466      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    467467      ELSE                                      ;   it_offset = 0 
    468468      ENDIF 
    … …  
    656656            ENDIF 
    657657         CASE DEFAULT 
    658             IF (lk_c1d .AND. lmoor ) THEN 
     658            IF(lk_c1d .AND. lmoor ) THEN 
    659659               IF( sdjf%ln_tint ) THEN 
    660660                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 
    … …  
    10711071         imonth = kmonth 
    10721072         iday = kday 
    1073          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     1073         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    10741074            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )   
    10751075            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    … …  
    10801080         ENDIF 
    10811081      ELSE                                                  ! use current day values 
    1082          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     1082         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    10831083            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
    10841084            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    … …  
    13181318 
    13191319      !! get dimensions 
    1320       IF ( SIZE(sd%fnow, 3) > 1 ) THEN 
     1320      !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1321      !IF( SIZE(sd%fnow, 3) > 1 ) THEN 
     1322      IF( SIZE(sd%fnow, 3) > 0 ) THEN 
    13211323         ALLOCATE( ddims(4) ) 
    13221324      ELSE 
    … …  
    13311333 
    13321334      CALL iom_open ( sd%wgtname, inum )   ! interpolation weights 
    1333       IF ( inum > 0 ) THEN 
     1335      IF( inum > 0 ) THEN 
    13341336 
    13351337         !! determine whether we have an east-west cyclic grid 
    … …  
    16401642          
    16411643         ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
    1642          SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
    1643          CASE(1) 
    1644               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
    1645          CASE DEFAULT 
     1644         !!GS: we consider 2D data as 3D data with vertical dim size = 1  
     1645         !SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     1646         !CASE(1) 
     1647         !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     1648         !CASE DEFAULT 
    16461649              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
    1647          END SELECT  
     1650         !END SELECT  
    16481651      ENDIF 
    16491652       
    … …  
    16631666      END DO 
    16641667 
    1665       IF (ref_wgts(kw)%numwgt .EQ. 16) THEN 
     1668      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN 
    16661669 
    16671670        !! fix up halo points that we couldnt read from file 
    … …  
    16891692           IF( jpi1 == 2 ) THEN 
    16901693              rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 
    1691               SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
    1692               CASE(1) 
    1693                    CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
    1694               CASE DEFAULT 
     1694              !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1695              !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
     1696              !CASE(1) 
     1697              !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1698              !CASE DEFAULT 
    16951699                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    1696               END SELECT       
     1700              !END SELECT       
    16971701              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    16981702           ENDIF 
    16991703           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    17001704              rec1(1) = 1 + ref_wgts(kw)%overlap 
    1701               SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
    1702               CASE(1) 
    1703                    CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
    1704               CASE DEFAULT 
     1705              !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1706              !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
     1707              !CASE(1) 
     1708              !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1709              !CASE DEFAULT 
    17051710                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    1706               END SELECT 
     1711              !END SELECT 
    17071712              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    17081713           ENDIF 
    … …  
    17461751         END DO 
    17471752         ! 
    1748       END IF 
     1753      ENDIF 
    17491754      ! 
    17501755   END SUBROUTINE fld_interp 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbc_oce.F90

    r10882 r12154  
    1111   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model  
    1212   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk) 
     13   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode     
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    3435   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation 
    3536   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation 
     37   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model 
    3638#if defined key_oasis3 
    3739   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    … …  
    7779   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
    7880   INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation 
    79    INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation 
    80    INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_abl     = 4        !: Atmospheric boundary layer    formulation 
     82   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
     83   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module 
    8184    
    8285   !!---------------------------------------------------------------------- 
    … …  
    107110   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere 
    108111   ! 
    109    LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
    110112   !!                                   !!   now    ! before   !! 
    111113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
    112114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2] 
    113115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]  
    114    !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads 
     116   !! wndm is used compute surface gases exchanges in ice-free ocean or leads 
    115117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rhoa              !: air density at "rn_zu" m above the sea       [kg/m3] !LB 
    116119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
    117120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
    … …  
    137140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    138141 
     142   !!--------------------------------------------------------------------- 
     143   !! ABL Vertical Domain size   
     144   !!--------------------------------------------------------------------- 
     145   INTEGER , PUBLIC            ::   jpka   = 2     !: ABL number of vertical levels (default definition) 
     146   INTEGER , PUBLIC            ::   jpkam1 = 1     !: jpka-1 
     147   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ght_abl, ghw_abl          !: ABL geopotential height (needed for iom) 
     148   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_abl, e3w_abl          !: ABL vertical scale factors (needed for iom) 
     149 
    139150   !!---------------------------------------------------------------------- 
    140151   !!                     Sea Surface Mean fields 
    … …  
    167178      ! 
    168179      ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     & 
    169          &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )  
     180         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )  
    170181         ! 
    171182      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        & 
    … …  
    182193         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
    183194         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    184          ! 
     195      ! 
    185196      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
    186          ! 
     197      ! 
    187198      sbc_oce_alloc = MAXVAL( ierr ) 
    188199      CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc ) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcapr.F90

    r11536 r12154  
    103103      ! 
    104104      !                                            !* control check 
    105       IF ( ln_apr_obc  ) THEN 
     105      IF( ln_apr_obc  ) THEN 
    106106         IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
    107107      ENDIF 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcblk.F90

    r12109 r12154  
    1515   !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk 
    1616   !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore 
    17    !!                 !                        ==> based on AeroBulk (http://aerobulk.sourceforge.net/) 
     17   !!                 !                        ==> based on AeroBulk (https://github.com/brodeau/aerobulk/) 
    1818   !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine 
    19    !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle)  
     19   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
     20   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
    2021   !!---------------------------------------------------------------------- 
    2122 
    … …  
    2324   !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition 
    2425   !!   sbc_blk       : bulk formulation as ocean surface boundary condition 
    25    !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean 
    26    !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP 
    27    !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air) 
    28    !!   q_sat         : saturation humidity as a function of SLP and temperature 
    29    !!   L_vap         : latent heat of vaporization of water as a function of temperature 
    30    !!             sea-ice case only :  
    31    !!   blk_ice_tau   : provide the air-ice stress 
    32    !!   blk_ice_flx   : provide the heat and mass fluxes at air-ice interface 
     26   !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE) 
     27   !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE) 
     28   !!             sea-ice case only : 
     29   !!   blk_ice_1   : provide the air-ice stress 
     30   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface 
    3331   !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    3432   !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    35    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag  
     33   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    3634   !!---------------------------------------------------------------------- 
    3735   USE oce            ! ocean dynamics and tracers 
    … …  
    4644   USE lib_fortran    ! to use key_nosignedzero 
    4745#if defined key_si3 
    48    USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif 
     46   USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif 
    4947   USE icethd_dh      ! for CALL ice_thd_snwblow 
    5048#endif 
    51    USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)  
    52    USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003)  
    53    USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013) 
    54    USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31)  
     49   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
     50   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003) 
     51   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013) 
     52   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1) 
    5553   ! 
    5654   USE iom            ! I/O manager library 
    … …  
    6058   USE prtctl         ! Print control 
    6159 
     60   USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 
     61 
     62 
    6263   IMPLICIT NONE 
    6364   PRIVATE 
    … …  
    6566   PUBLIC   sbc_blk_init  ! called in sbcmod 
    6667   PUBLIC   sbc_blk       ! called in sbcmod 
     68   PUBLIC   blk_oce_1     ! called in sbcabl 
     69   PUBLIC   blk_oce_2     ! called in sbcabl 
    6770#if defined key_si3 
    68    PUBLIC   blk_ice_tau   ! routine called in icesbc 
    69    PUBLIC   blk_ice_flx   ! routine called in icesbc 
     71   PUBLIC   blk_ice_1     ! routine called in icesbc 
     72   PUBLIC   blk_ice_2     ! routine called in icesbc 
    7073   PUBLIC   blk_ice_qcn   ! routine called in icesbc 
    71 #endif  
    72  
    73 !!Lolo: should ultimately be moved in the module with all physical constants ? 
    74 !!gm  : In principle, yes. 
    75    REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg] 
    76    REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg] 
    77    REAL(wp), PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg] 
    78    REAL(wp), PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg] 
    79    REAL(wp), PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622 
    80    REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    81  
    82    INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read 
    83    INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    84    INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    85    INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin) 
    86    INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % ) 
    87    INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2) 
    88    INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2) 
    89    INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    90    INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    91    INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa) 
    92    INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    93  
    94    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    95  
    96    !                                             !!! Bulk parameters 
    97    REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...) 
    98    REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation 
    99    REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant 
    100    REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice 
    101    REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant 
    102    ! 
     74#endif 
     75 
     76   INTEGER , PUBLIC            ::   jpfld         ! maximum number of files to read 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_wndi = 1   ! index of 10m wind velocity (i-component) (m/s)    at T-point 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_wndj = 2   ! index of 10m wind velocity (j-component) (m/s)    at T-point 
     79   INTEGER , PUBLIC, PARAMETER ::   jp_tair = 3   ! index of 10m air temperature             (Kelvin) 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_humi = 4   ! index of specific humidity               ( % ) 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_qsr  = 5   ! index of solar heat                      (W/m2) 
     82   INTEGER , PUBLIC, PARAMETER ::   jp_qlw  = 6   ! index of Long wave                       (W/m2) 
     83   INTEGER , PUBLIC, PARAMETER ::   jp_prec = 7   ! index of total precipitation (rain+snow) (Kg/m2/s) 
     84   INTEGER , PUBLIC, PARAMETER ::   jp_snow = 8   ! index of snow (solid prcipitation)       (kg/m2/s) 
     85   INTEGER , PUBLIC, PARAMETER ::   jp_slp  = 9   ! index of sea level pressure              (Pa) 
     86   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi =10   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 
     87   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
     88 
     89   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input atmospheric fields (file informations, fields read) 
     90 
    10391   !                           !!* Namelist namsbc_blk : bulk parameters 
    10492   LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008) 
    10593   LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    106    LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    107    LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31) 
     94   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     95   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    10896   ! 
    109    LOGICAL  ::   ln_taudif      ! logical flag to use the "mean of stress module - module of mean stress" data 
    110    REAL(wp) ::   rn_pfac        ! multiplication factor for precipitation 
    111    REAL(wp) ::   rn_efac        ! multiplication factor for evaporation 
    112    REAL(wp) ::   rn_vfac        ! multiplication factor for ice/ocean velocity in the calculation of wind stress 
    113    REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements 
    114    REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements 
    115 !!gm ref namelist initialize it so remove the setting to false below 
    116    LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012) 
    117    LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015) 
     97   LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
     98   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
    11899   ! 
    119    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau) 
    120    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens) 
    121    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat) 
    122    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme) 
    123    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme) 
    124    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme 
     100   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation 
     101   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation 
     102   REAL(wp), PUBLIC ::   rn_vfac   ! multiplication factor for ice/ocean velocity in the calculation of wind stress 
     103   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements 
     104   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements 
     105   ! 
     106   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
     107   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme) 
     108   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     109 
     110   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB 
     111   LOGICAL  ::   ln_skin_wl     ! use the warm-layer parameterization (only available in ECMWF and COARE algorithms) !LB 
     112   LOGICAL  ::   ln_humi_sph    ! humidity read in files ("sn_humi") is specific humidity [kg/kg] if .true. !LB 
     113   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB 
     114   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB 
     115   ! 
     116   INTEGER  ::   nhumi          ! choice of the bulk algorithm 
     117   !                            ! associated indices: 
     118   INTEGER, PARAMETER :: np_humi_sph = 1 
     119   INTEGER, PARAMETER :: np_humi_dpt = 2 
     120   INTEGER, PARAMETER :: np_humi_rlh = 3 
    125121 
    126122   INTEGER  ::   nblk           ! choice of the bulk algorithm 
    … …  
    128124   INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008) 
    129125   INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    130    INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    131    INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31) 
     126   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     127   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1) 
    132128 
    133129   !! * Substitutions 
    … …  
    144140      !!             ***  ROUTINE sbc_blk_alloc *** 
    145141      !!------------------------------------------------------------------- 
    146       ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 
    147          &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
     142      ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      & 
     143         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    & 
     144         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 
    148145      ! 
    149146      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
    … …  
    158155      !! ** Purpose :   choose and initialize a bulk formulae formulation 
    159156      !! 
    160       !! ** Method  :  
     157      !! ** Method  : 
    161158      !! 
    162159      !!---------------------------------------------------------------------- 
    163       INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
     160      INTEGER  ::   jfpr                  ! dummy loop indice and argument 
    164161      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    165162      !! 
    166163      CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files 
    167       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
     164      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i        ! array of namelist informations on the fields to read 
    168165      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    169166      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
    170       TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        " 
     167      TYPE(FLD_N) ::   sn_slp , sn_hpgi, sn_hpgj               !       "                        " 
    171168      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    172          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
    173          &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    174          &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         &  
    175          &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15 
     169         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj,       & 
     170         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm 
     171         &                 cn_dir , rn_zqt, rn_zu,                                    & 
     172         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15,           & 
     173         &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB 
    176174      !!--------------------------------------------------------------------- 
    177175      ! 
    … …  
    179177      IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
    180178      ! 
    181       !                             !** read bulk namelist   
     179      !                             !** read bulk namelist 
    182180      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters 
    183181      READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901) 
    … …  
    192190      !                             !** initialization of the chosen bulk formulae (+ check) 
    193191      !                                   !* select the bulk chosen in the namelist and check the choice 
    194                                                                ioptio = 0 
    195       IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF 
    196       IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF 
    197       IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF 
    198       IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF 
    199       ! 
     192      ioptio = 0 
     193      IF( ln_NCAR      ) THEN 
     194         nblk =  np_NCAR        ;   ioptio = ioptio + 1 
     195      ENDIF 
     196      IF( ln_COARE_3p0 ) THEN 
     197         nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1 
     198      ENDIF 
     199      IF( ln_COARE_3p6 ) THEN 
     200         nblk =  np_COARE_3p6   ;   ioptio = ioptio + 1 
     201      ENDIF 
     202      IF( ln_ECMWF     ) THEN 
     203         nblk =  np_ECMWF       ;   ioptio = ioptio + 1 
     204      ENDIF 
    200205      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' ) 
     206 
     207      !                             !** initialization of the cool-skin / warm-layer parametrization 
     208      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     209         !! Some namelist sanity tests: 
     210         IF( ln_NCAR )      & 
     211            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' ) 
     212         IF( nn_fsbc /= 1 ) & 
     213            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 
     214      END IF 
     215 
     216      IF( ln_skin_wl ) THEN 
     217         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily! 
     218         IF( (sn_qsr%freqh  < 0.).OR.(sn_qsr%freqh  > 24.) ) & 
     219            & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' ) 
     220         IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) & 
     221            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' ) 
     222      END IF 
     223 
     224      ioptio = 0 
     225      IF( ln_humi_sph ) THEN 
     226         nhumi =  np_humi_sph    ;   ioptio = ioptio + 1 
     227      ENDIF 
     228      IF( ln_humi_dpt ) THEN 
     229         nhumi =  np_humi_dpt    ;   ioptio = ioptio + 1 
     230      ENDIF 
     231      IF( ln_humi_rlh ) THEN 
     232         nhumi =  np_humi_rlh    ;   ioptio = ioptio + 1 
     233      ENDIF 
     234      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one type of air humidity' ) 
    201235      ! 
    202236      IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr 
    203237         IF( sn_qsr%freqh /= 24. )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' ) 
    204          IF( sn_qsr%ln_tint ) THEN  
     238         IF( sn_qsr%ln_tint ) THEN 
    205239            CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   & 
    206240               &           '              ==> We force time interpolation = .false. for qsr' ) 
    … …  
    210244      !                                   !* set the bulk structure 
    211245      !                                      !- store namelist information in an array 
     246      IF( ln_blk ) jpfld = 9 
     247      IF( ln_abl ) jpfld = 11 
     248      ALLOCATE( slf_i(jpfld) ) 
     249      ! 
    212250      slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    213251      slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
    214252      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    215253      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    216       slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
    217       ! 
    218       lhftau = ln_taudif                     !- add an extra field if HF stress is used 
    219       jfld = jpfld - COUNT( (/.NOT.lhftau/) ) 
     254      slf_i(jp_slp ) = sn_slp 
     255      IF( ln_abl ) THEN 
     256         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj 
     257      END IF 
    220258      ! 
    221259      !                                      !- allocate the bulk structure 
    222       ALLOCATE( sf(jfld), STAT=ierror ) 
     260      ALLOCATE( sf(jpfld), STAT=ierror ) 
    223261      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 
    224       DO ifpr= 1, jfld 
    225          ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226          IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227          IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
    228             &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    229             &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
    230  
     262      ! 
     263      DO jfpr= 1, jpfld 
     264         ! 
     265         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
     266            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     267            sf(jfpr)%fnow(:,:,1) = 0._wp 
     268         ELSE                                                  !-- used field  --! 
     269            IF(   ln_abl    .AND.                                                      & 
     270               &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   & 
     271               &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input 
     272               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 
     273               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 
     274            ELSE                                                                                ! others or Bulk fields are 2D fiels 
     275               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     276               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
     277            ENDIF 
     278            ! 
     279            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
     280               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
     281               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     282         ENDIF 
    231283      END DO 
    232284      !                                      !- fill the bulk structure with namelist informations 
    233285      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
    234286      ! 
    235       IF ( ln_wave ) THEN 
    236       !Activated wave module but neither drag nor stokes drift activated 
    237          IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
     287      IF( ln_wave ) THEN 
     288         !Activated wave module but neither drag nor stokes drift activated 
     289         IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
    238290            CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 
    239       !drag coefficient read from wave model definable only with mfs bulk formulae and core  
    240          ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN        
    241              CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
    242          ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN 
    243              CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     291            !drag coefficient read from wave model definable only with mfs bulk formulae and core 
     292         ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN 
     293            CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
     294         ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN 
     295            CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
    244296         ENDIF 
    245297      ELSE 
    246       IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                &  
    247          &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
    248          &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
    249          &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
    250          &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &   
    251          &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
    252       ENDIF  
    253       ! 
    254       !            
     298         IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
     299            &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
     300            &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
     301            &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
     302            &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      & 
     303            &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
     304      ENDIF 
     305      ! 
     306      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient 
     307         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level 
     308         rn_zu  = ght_abl(2) 
     309         IF(lwp) WRITE(numout,*) 
     310         IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 
     311      ENDIF 
     312      ! 
     313      ! set transfer coefficients to default sea-ice values 
     314      Cd_ice(:,:) = rCd_ice 
     315      Ch_ice(:,:) = rCd_ice 
     316      Ce_ice(:,:) = rCd_ice 
     317      ! 
    255318      IF(lwp) THEN                     !** Control print 
    256319         ! 
    257          WRITE(numout,*)                  !* namelist  
     320         WRITE(numout,*)                  !* namelist 
    258321         WRITE(numout,*) '   Namelist namsbc_blk (other than data information):' 
    259322         WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR 
    260323         WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0 
    261          WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0 
    262          WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF 
    263          WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif 
     324         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6 
     325         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF 
    264326         WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt 
    265327         WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu 
    … …  
    275337         CASE( np_NCAR      )   ;   WRITE(numout,*) '   ==>>>   "NCAR" algorithm        (Large and Yeager 2008)' 
    276338         CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.0" algorithm   (Fairall et al. 2003)' 
    277          CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.5" algorithm   (Edson et al. 2013)' 
    278          CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 31)' 
     339         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)' 
     340         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)' 
    279341         END SELECT 
    280342         ! 
     343         WRITE(numout,*) 
     344         WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs 
     345         WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl 
     346         ! 
     347         WRITE(numout,*) 
     348         SELECT CASE( nhumi )              !* Print the choice of air humidity 
     349         CASE( np_humi_sph )   ;   WRITE(numout,*) '   ==>>>   air humidity is SPECIFIC HUMIDITY     [kg/kg]' 
     350         CASE( np_humi_dpt )   ;   WRITE(numout,*) '   ==>>>   air humidity is DEW-POINT TEMPERATURE [K]' 
     351         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]' 
     352         END SELECT 
     353         ! 
    281354      ENDIF 
    282355      ! 
    … …  
    291364      !!              (momentum, heat, freshwater and runoff) 
    292365      !! 
    293       !! ** Method  : (1) READ each fluxes in NetCDF files: 
    294       !!      the 10m wind velocity (i-component) (m/s)    at T-point 
    295       !!      the 10m wind velocity (j-component) (m/s)    at T-point 
    296       !!      the 10m or 2m specific humidity     ( % ) 
    297       !!      the solar heat                      (W/m2) 
    298       !!      the Long wave                       (W/m2) 
    299       !!      the 10m or 2m air temperature       (Kelvin) 
    300       !!      the total precipitation (rain+snow) (Kg/m2/s) 
    301       !!      the snow (solid prcipitation)       (kg/m2/s) 
    302       !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T) 
    303       !!              (2) CALL blk_oce 
     366      !! ** Method  : 
     367      !!              (1) READ each fluxes in NetCDF files: 
     368      !!      the wind velocity (i-component) at z=rn_zu  (m/s) at T-point 
     369      !!      the wind velocity (j-component) at z=rn_zu  (m/s) at T-point 
     370      !!      the specific humidity           at z=rn_zqt (kg/kg) 
     371      !!      the air temperature             at z=rn_zqt (Kelvin) 
     372      !!      the solar heat                              (W/m2) 
     373      !!      the Long wave                               (W/m2) 
     374      !!      the total precipitation (rain+snow)         (Kg/m2/s) 
     375      !!      the snow (solid precipitation)              (kg/m2/s) 
     376      !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds) 
     377      !!              (2) CALL blk_oce_1 and blk_oce_2 
    304378      !! 
    305379      !!      C A U T I O N : never mask the surface stress fields 
    … …  
    318392      !!---------------------------------------------------------------------- 
    319393      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    320       !!--------------------------------------------------------------------- 
     394      !!---------------------------------------------------------------------- 
     395      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp 
     396      REAL(wp) :: ztmp 
     397      !!---------------------------------------------------------------------- 
    321398      ! 
    322399      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    323       ! 
     400 
     401      ! Sanity/consistence test on humidity at first time step to detect potential screw-up: 
     402      IF( kt == nit000 ) THEN 
     403         WRITE(numout,*) '' 
     404#if defined key_agrif 
     405         WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 
     406#else 
     407         ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 
     408         IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 
     409            ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc 
     410            SELECT CASE( nhumi ) 
     411            CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 
     412               IF(  (ztmp < 0._wp) .OR. (ztmp > 0.065)  ) ztmp = -1._wp 
     413            CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 
     414               IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp 
     415            CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 
     416               IF(  (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp 
     417            END SELECT 
     418            IF(ztmp < 0._wp) THEN 
     419               WRITE(numout,'("   Mean humidity value found on proc #",i5.5," is: ",f)'), narea, ztmp 
     420               CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', & 
     421                  &   ' ==> check the unit in your input files'       , & 
     422                  &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 
     423                  &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 
     424            END IF 
     425         END IF 
     426         WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 
     427#endif 
     428         WRITE(numout,*) '' 
     429      END IF !IF( kt == nit000 ) 
    324430      !                                            ! compute the surface ocean fluxes using bulk formulea 
    325       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m ) 
    326  
     431      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     432         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in 
     433            &                sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &   !   <<= in 
     434            &                sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m,       &   !   <<= in 
     435            &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
     436            &                zssq, zcd_du, zsen, zevp )                              !   =>> out 
     437 
     438         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in 
     439            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in 
     440            &                sf(jp_snow)%fnow(:,:,1), sst_m,                     &   !   <<= in 
     441            &                zsen, zevp )                                            !   <=> in out 
     442      ENDIF 
     443      ! 
    327444#if defined key_cice 
    328445      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    329446         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
    330          IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
    331          ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)  
    332          ENDIF  
     447         IF( ln_dm2dc ) THEN 
     448            qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
     449         ELSE 
     450            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
     451         ENDIF 
    333452         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    334          qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
     453 
     454         SELECT CASE( nhumi ) 
     455         CASE( np_humi_sph ) 
     456            qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1) 
     457         CASE( np_humi_dpt ) 
     458            qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
     459         CASE( np_humi_rlh ) 
     460            qatm_ice(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) !LB: 0.01 => RH is % percent in file 
     461         END SELECT 
     462 
    335463         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
    336464         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
    … …  
    343471 
    344472 
    345    SUBROUTINE blk_oce( kt, sf, pst, pu, pv ) 
    346       !!--------------------------------------------------------------------- 
    347       !!                     ***  ROUTINE blk_oce  *** 
    348       !! 
    349       !! ** Purpose :   provide the momentum, heat and freshwater fluxes at 
    350       !!      the ocean surface at each time step 
    351       !! 
    352       !! ** Method  :   bulk formulea for the ocean using atmospheric 
    353       !!      fields read in sbc_read 
     473   SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp 
     474      &              pslp , pst   , pu   , pv,    &  ! inp 
     475      &              pqsr , pqlw  ,               &  ! inp 
     476      &              pssq , pcd_du, psen , pevp   )  ! out 
     477      !!--------------------------------------------------------------------- 
     478      !!                     ***  ROUTINE blk_oce_1  *** 
     479      !! 
     480      !! ** Purpose :   if ln_blk=T, computes surface momentum, heat and freshwater fluxes 
     481      !!                if ln_abl=T, computes Cd x |U|, Ch x |U|, Ce x |U| for ABL integration 
     482      !! 
     483      !! ** Method  :   bulk formulae using atmospheric fields from : 
     484      !!                if ln_blk=T, atmospheric fields read in sbc_read 
     485      !!                if ln_abl=T, the ABL model at previous time-step 
     486      !! 
     487      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg) 
     488      !!              - pcd_du  : Cd x |dU| at T-points  (m/s) 
     489      !!              - psen    : Ch x |dU| at T-points  (m/s) 
     490      !!              - pevp    : Ce x |dU| at T-points  (m/s) 
     491      !!--------------------------------------------------------------------- 
     492      INTEGER , INTENT(in   )                 ::   kt     ! time step index 
     493      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s] 
     494      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s] 
     495      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg] 
     496      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin] 
     497      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa] 
     498      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pst    ! surface temperature                      [Celcius] 
     499      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s] 
     500      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s] 
     501      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   ! 
     502      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   ! 
     503      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg] 
     504      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s] 
     505      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s] 
     506      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s] 
     507      ! 
     508      INTEGER  ::   ji, jj               ! dummy loop indices 
     509      REAL(wp) ::   zztmp                ! local variable 
     510      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
     511      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin 
     512      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
     513      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
     514      REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg] 
     515      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean 
     516      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean 
     517      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean 
     518      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux 
     519      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2 
     520      !!--------------------------------------------------------------------- 
     521      ! 
     522      ! local scalars ( place there for vector optimisation purposes) 
     523      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
     524 
     525      ! ----------------------------------------------------------------------------- ! 
     526      !      0   Wind components and module at T-point relative to the moving ocean   ! 
     527      ! ----------------------------------------------------------------------------- ! 
     528 
     529      ! ... components ( U10m - U_oce ) at T-point (unmasked) 
     530#if defined key_cyclone 
     531      zwnd_i(:,:) = 0._wp 
     532      zwnd_j(:,:) = 0._wp 
     533      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
     534      DO jj = 2, jpjm1 
     535         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     536            pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 
     537            pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 
     538         END DO 
     539      END DO 
     540#endif 
     541      DO jj = 2, jpjm1 
     542         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     543            zwnd_i(ji,jj) = (  pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     544            zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     545         END DO 
     546      END DO 
     547      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 
     548      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
     549      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
     550         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
     551 
     552      ! ----------------------------------------------------------------------------- ! 
     553      !      I   Solar FLUX                                                           ! 
     554      ! ----------------------------------------------------------------------------- ! 
     555 
     556      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave 
     557      zztmp = 1. - albo 
     558      IF( ln_dm2dc ) THEN 
     559         qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
     560      ELSE 
     561         qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     562      ENDIF 
     563 
     564 
     565      ! ----------------------------------------------------------------------------- ! 
     566      !     II   Turbulent FLUXES                                                     ! 
     567      ! ----------------------------------------------------------------------------- ! 
     568 
     569      ! specific humidity at SST 
     570      pssq(:,:) = rdct_qsat_salt * q_sat( zst(:,:), pslp(:,:) ) 
     571 
     572      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     573         zztmp1(:,:) = zst(:,:) 
     574         zztmp2(:,:) = pssq(:,:) 
     575      ENDIF 
     576 
     577      ! specific humidity of air at "rn_zqt" m above the sea 
     578      SELECT CASE( nhumi ) 
     579      CASE( np_humi_sph ) 
     580         zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity! 
     581      CASE( np_humi_dpt ) 
     582         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm 
     583         zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) ) 
     584      CASE( np_humi_rlh ) 
     585         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm 
     586         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
     587      END SELECT 
     588      ! 
     589      ! potential temperature of air at "rn_zqt" m above the sea 
     590      IF( ln_abl ) THEN 
     591         ztpot = ptair(:,:) 
     592      ELSE 
     593         ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
     594         !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
     595         !    (since reanalysis products provide T at z, not theta !) 
     596         !#LB: because AGRIF hates functions that return something else than a scalar, need to 
     597         !     use scalar version of gamma_moist() ... 
     598         DO jj = 1, jpj 
     599            DO ji = 1, jpi 
     600               ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
     601            END DO 
     602         END DO 
     603      ENDIF 
     604 
     605 
     606 
     607      !! Time to call the user-selected bulk parameterization for 
     608      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more... 
     609      SELECT CASE( nblk ) 
     610 
     611      CASE( np_NCAR      ) 
     612         CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm,                              & 
     613            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     614 
     615      CASE( np_COARE_3p0 ) 
     616         CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     617            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     618            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     619 
     620      CASE( np_COARE_3p6 ) 
     621         CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     622            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     623            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     624 
     625      CASE( np_ECMWF     ) 
     626         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
     627            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     628            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     629 
     630      CASE DEFAULT 
     631         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
     632 
     633      END SELECT 
     634 
     635      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     636         !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of zst and pssq: 
     637         WHERE ( fr_i < 0.001_wp ) 
     638            ! zst and pssq have been updated by cool-skin/warm-layer scheme and we keep it!!! 
     639            zst(:,:)  =  zst(:,:)*tmask(:,:,1) 
     640            pssq(:,:) = pssq(:,:)*tmask(:,:,1) 
     641         ELSEWHERE 
     642            ! we forget about the update... 
     643            zst(:,:)  = zztmp1(:,:) !#LB: using what we backed up before skin-algo 
     644            pssq(:,:) = zztmp2(:,:) !#LB:  "   "   " 
     645         END WHERE 
     646      END IF 
     647 
     648      !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef. 
     649      !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef. 
     650 
     651      IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
     652         !! If zu == zt, then ensuring once for all that: 
     653         t_zu(:,:) = ztpot(:,:) 
     654         q_zu(:,:) = zqair(:,:) 
     655      ENDIF 
     656 
     657 
     658      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
     659      ! ------------------------------------------------------------- 
     660 
     661      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp 
     662         !! FL do we need this multiplication by tmask ... ??? 
     663         DO jj = 1, jpj 
     664            DO ji = 1, jpi 
     665               zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 
     666               wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
     667               pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
     668               psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
     669               pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
     670            END DO 
     671         END DO 
     672      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
     673         CALL BULK_FORMULA( rn_zu, zst(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 
     674            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),         & 
     675            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                 & 
     676            &               taum(:,:), psen(:,:), zqla(:,:),                  & 
     677            &               pEvap=pevp(:,:), prhoa=rhoa(:,:) ) 
     678 
     679         zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
     680         psen(:,:) = psen(:,:) * tmask(:,:,1) 
     681         taum(:,:) = taum(:,:) * tmask(:,:,1) 
     682         pevp(:,:) = pevp(:,:) * tmask(:,:,1) 
     683 
     684         ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array... 
     685         zcd_oce = 0._wp 
     686         WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm 
     687         zwnd_i = zcd_oce * zwnd_i 
     688         zwnd_j = zcd_oce * zwnd_j 
     689 
     690         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
     691 
     692         ! ... utau, vtau at U- and V_points, resp. 
     693         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
     694         !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
     695         DO jj = 1, jpjm1 
     696            DO ji = 1, fs_jpim1 
     697               utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
     698                  &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
     699               vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) & 
     700                  &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
     701            END DO 
     702         END DO 
     703         CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     704 
     705         IF(ln_ctl) THEN 
     706            CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ') 
     707            CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   & 
     708               &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask ) 
     709         ENDIF 
     710         ! 
     711      ENDIF 
     712      ! 
     713      IF(ln_ctl) THEN 
     714         CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' ) 
     715         CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' ) 
     716         CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' ) 
     717      ENDIF 
     718      ! 
     719   END SUBROUTINE blk_oce_1 
     720 
     721 
     722   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in 
     723      &          psnow, pst , psen, pevp     )   ! <<= in 
     724      !!--------------------------------------------------------------------- 
     725      !!                     ***  ROUTINE blk_oce_2  *** 
     726      !! 
     727      !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation 
     728      !!                at the ocean surface at each time step knowing Cd, Ch, Ce and 
     729      !!                atmospheric variables (from ABL or external data) 
    354730      !! 
    355731      !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2) 
    … …  
    360736      !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    361737      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    362       !! 
    363       !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    364       !!--------------------------------------------------------------------- 
    365       INTEGER  , INTENT(in   )                 ::   kt    ! time step index 
    366       TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data 
    367       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
    368       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
    369       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
     738      !!--------------------------------------------------------------------- 
     739      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair 
     740      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr 
     741      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw 
     742      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec 
     743      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow 
     744      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
     745      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen 
     746      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp 
    370747      ! 
    371748      INTEGER  ::   ji, jj               ! dummy loop indices 
    372       REAL(wp) ::   zztmp                ! local variable 
    373       REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
    374       REAL(wp), DIMENSION(jpi,jpj) ::   zsq               ! specific humidity at pst 
    375       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
    376       REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation 
     749      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable 
     750      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes 
     751      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation 
    377752      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin 
    378       REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    379       REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
    380       REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa             ! density of air   [kg/m^3] 
    381753      !!--------------------------------------------------------------------- 
    382754      ! 
    … …  
    384756      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    385757 
     758 
    386759      ! ----------------------------------------------------------------------------- ! 
    387       !      0   Wind components and module at T-point relative to the moving ocean   ! 
     760      !     III    Net longwave radiative FLUX                                        ! 
    388761      ! ----------------------------------------------------------------------------- ! 
    389762 
    390       ! ... components ( U10m - U_oce ) at T-point (unmasked) 
    391 !!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ??? 
    392       zwnd_i(:,:) = 0._wp 
    393       zwnd_j(:,:) = 0._wp 
    394 #if defined key_cyclone 
    395       CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    396       DO jj = 2, jpjm1 
    397          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    398             sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj) 
    399             sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj) 
    400          END DO 
    401       END DO 
    402 #endif 
    403       DO jj = 2, jpjm1 
    404          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    405             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    406             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    407          END DO 
    408       END DO 
    409       CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 
    410       ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    411       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    412          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
    413  
    414       ! ----------------------------------------------------------------------------- ! 
    415       !      I   Radiative FLUXES                                                     ! 
    416       ! ----------------------------------------------------------------------------- ! 
    417  
    418       ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave 
    419       zztmp = 1. - albo 
    420       IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
    421       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    422       ENDIF 
    423  
    424       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    425  
    426       ! ----------------------------------------------------------------------------- ! 
    427       !     II    Turbulent FLUXES                                                    ! 
    428       ! ----------------------------------------------------------------------------- ! 
    429  
    430       ! ... specific humidity at SST and IST tmask( 
    431       zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) ) 
    432       !! 
    433       !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
    434       !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
    435       !!    (since reanalysis products provide T at z, not theta !) 
    436       ztpot = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1) ) * rn_zqt 
    437  
    438       SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point 
    439       ! 
    440       CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2 
    441          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    442       CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0 
    443          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    444       CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5 
    445          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    446       CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF 
    447          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    448       CASE DEFAULT 
    449          CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
    450       END SELECT 
    451  
    452       !                          ! Compute true air density : 
    453       IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...) 
    454          zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) ) 
    455       ELSE                                      ! At zt: 
    456          zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    457       END IF 
    458  
    459 !!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef. 
    460 !!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef. 
    461  
    462       DO jj = 1, jpj             ! tau module, i and j component 
    463          DO ji = 1, jpi 
    464             zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed 
    465             taum  (ji,jj) = zztmp * wndm  (ji,jj) 
    466             zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
    467             zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
    468          END DO 
    469       END DO 
    470  
    471       !                          ! add the HF tau contribution to the wind stress module 
    472       IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    473  
    474       CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    475  
    476       ! ... utau, vtau at U- and V_points, resp. 
    477       !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    478       !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    479       DO jj = 1, jpjm1 
    480          DO ji = 1, fs_jpim1 
    481             utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    482                &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    483             vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) & 
    484                &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
    485          END DO 
    486       END DO 
    487       CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     763      !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST 
     764      !! (zst is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
     765      zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux 
    488766 
    489767      !  Turbulent fluxes over ocean 
    490768      ! ----------------------------- 
    491769 
    492       ! zqla used as temporary array, for rho*U (common term of bulk formulae): 
    493       zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) * tmask(:,:,1) 
    494  
    495       IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
    496          !! q_air and t_air are given at 10m (wind reference height) 
    497          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 
    498          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed 
    499       ELSE 
    500          !! q_air and t_air are not given at 10m (wind reference height) 
    501          ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
    502          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed 
    503          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed 
    504       ENDIF 
    505  
    506       zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux 
    507  
     770      ! use scalar version of L_vap() for AGRIF compatibility 
     771      DO jj = 1, jpj 
     772         DO ji = 1, jpi 
     773            zqla(ji,jj) = L_vap( zst(ji,jj) ) * pevp(ji,jj) * -1._wp    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 
     774         ENDDO 
     775      ENDDO 
    508776 
    509777      IF(ln_ctl) THEN 
    510          CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' ) 
    511          CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' ) 
    512          CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
    513          CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' ) 
    514          CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce: utau   : ', mask1=umask,   & 
    515             &          tab2d_2=vtau  , clinfo2=           ' vtau : ', mask2=vmask ) 
    516          CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce: wndm   : ') 
    517          CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce: zst    : ') 
     778         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' ) 
     779         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
     780 
    518781      ENDIF 
    519782 
    520783      ! ----------------------------------------------------------------------------- ! 
    521       !     III    Total FLUXES                                                       ! 
     784      !     IV    Total FLUXES                                                       ! 
    522785      ! ----------------------------------------------------------------------------- ! 
    523786      ! 
    524       emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    525          &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    526       ! 
    527       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
    528          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
    529          &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    530          &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    531          &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
    532          &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    533          &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi 
     787      emp (:,:) = (  pevp(:,:)                                       &   ! mass flux (evap. - precip.) 
     788         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1) 
     789      ! 
     790      qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar 
     791         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
     792         &     - pevp(:,:) * pst(:,:) * rcp                          &   ! remove evap heat content at SST !LB??? pst is Celsius !? 
     793         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac               &   ! add liquid precip heat content at Tair 
     794         &     * ( ptair(:,:) - rt0 ) * rcp                          & 
     795         &     + psnow(:,:) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
     796         &     * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi 
    534797      qns(:,:) = qns(:,:) * tmask(:,:,1) 
    535798      ! 
    536799#if defined key_si3 
    537       qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by SI3) 
     800      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3) 
    538801      qsr_oce(:,:) = qsr(:,:) 
    539802#endif 
    540803      ! 
     804      CALL iom_put( "rho_air"  , rhoa*tmask(:,:,1) )       ! output air density [kg/m^3] 
     805      CALL iom_put( "evap_oce" , pevp )                    ! evaporation 
     806      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean 
     807      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean 
     808      CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean 
     809      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s] 
     810      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s] 
     811      CALL iom_put( 'snowpre', sprecip )                   ! Snow 
     812      CALL iom_put( 'precip' , tprecip )                   ! Total precipitation 
     813      ! 
    541814      IF ( nn_ice == 0 ) THEN 
    542          CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean 
    543          CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean 
    544          CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean 
    545          CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    546          CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
    547          CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
    548          CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
    549          tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s] 
    550          sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s] 
    551          CALL iom_put( 'snowpre', sprecip )                 ! Snow 
    552          CALL iom_put( 'precip' , tprecip )                 ! Total precipitation 
     815         CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean 
     816         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean 
     817         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean 
     818         CALL iom_put( "qt_oce"   ,   qns+qsr )            ! output total downward heat over the ocean 
     819      ENDIF 
     820      ! 
     821      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     822         CALL iom_put( "t_skin" ,  (zst - rt0) * tmask(:,:,1) )           ! T_skin in Celsius 
     823         CALL iom_put( "dt_skin" , (zst - pst - rt0) * tmask(:,:,1) )     ! T_skin - SST temperature difference... 
    553824      ENDIF 
    554825      ! 
    555826      IF(ln_ctl) THEN 
    556          CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ') 
    557          CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
    558          CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ') 
    559          CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce: utau   : ', mask1=umask,   & 
    560             &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask ) 
    561       ENDIF 
    562       ! 
    563    END SUBROUTINE blk_oce 
    564  
    565  
    566  
    567    FUNCTION rho_air( ptak, pqa, pslp ) 
    568       !!------------------------------------------------------------------------------- 
    569       !!                           ***  FUNCTION rho_air  *** 
    570       !! 
    571       !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere 
    572       !! 
    573       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)  
    574       !!------------------------------------------------------------------------------- 
    575       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K] 
    576       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg] 
    577       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa] 
    578       REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3] 
    579       !!------------------------------------------------------------------------------- 
    580       ! 
    581       rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  ) 
    582       ! 
    583    END FUNCTION rho_air 
    584  
    585  
    586    FUNCTION cp_air( pqa ) 
    587       !!------------------------------------------------------------------------------- 
    588       !!                           ***  FUNCTION cp_air  *** 
    589       !! 
    590       !! ** Purpose : Compute specific heat (Cp) of moist air 
    591       !! 
    592       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    593       !!------------------------------------------------------------------------------- 
    594       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg] 
    595       REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air   [J/K/kg] 
    596       !!------------------------------------------------------------------------------- 
    597       ! 
    598       Cp_air = Cp_dry + Cp_vap * pqa 
    599       ! 
    600    END FUNCTION cp_air 
    601  
    602  
    603    FUNCTION q_sat( ptak, pslp ) 
    604       !!---------------------------------------------------------------------------------- 
    605       !!                           ***  FUNCTION q_sat  *** 
    606       !! 
    607       !! ** Purpose : Specific humidity at saturation in [kg/kg] 
    608       !!              Based on accurate estimate of "e_sat" 
    609       !!              aka saturation water vapor (Goff, 1957) 
    610       !! 
    611       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    612       !!---------------------------------------------------------------------------------- 
    613       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K] 
    614       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa] 
    615       REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg] 
    616       ! 
    617       INTEGER  ::   ji, jj         ! dummy loop indices 
    618       REAL(wp) ::   ze_sat, ztmp   ! local scalar 
    619       !!---------------------------------------------------------------------------------- 
    620       ! 
    621       DO jj = 1, jpj 
    622          DO ji = 1, jpi 
    623             ! 
    624             ztmp = rt0 / ptak(ji,jj) 
    625             ! 
    626             ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957) 
    627             ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        & 
    628                &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  & 
    629                &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  ) 
    630                ! 
    631             q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa] 
    632             ! 
    633          END DO 
    634       END DO 
    635       ! 
    636    END FUNCTION q_sat 
    637  
    638  
    639    FUNCTION gamma_moist( ptak, pqa ) 
    640       !!---------------------------------------------------------------------------------- 
    641       !!                           ***  FUNCTION gamma_moist  *** 
    642       !! 
    643       !! ** Purpose : Compute the moist adiabatic lapse-rate. 
    644       !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 
    645       !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html 
    646       !! 
    647       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    648       !!---------------------------------------------------------------------------------- 
    649       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K] 
    650       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg] 
    651       REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate 
    652       ! 
    653       INTEGER  ::   ji, jj         ! dummy loop indices 
    654       REAL(wp) :: zrv, ziRT        ! local scalar 
    655       !!---------------------------------------------------------------------------------- 
    656       ! 
    657       DO jj = 1, jpj 
    658          DO ji = 1, jpi 
    659             zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 
    660             ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT 
    661             gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) ) 
    662          END DO 
    663       END DO 
    664       ! 
    665    END FUNCTION gamma_moist 
    666  
    667  
    668    FUNCTION L_vap( psst ) 
    669       !!--------------------------------------------------------------------------------- 
    670       !!                           ***  FUNCTION L_vap  *** 
    671       !! 
    672       !! ** Purpose : Compute the latent heat of vaporization of water from temperature 
    673       !! 
    674       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    675       !!---------------------------------------------------------------------------------- 
    676       REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization   [J/kg] 
    677       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K] 
    678       !!---------------------------------------------------------------------------------- 
    679       ! 
    680       L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6 
    681       ! 
    682    END FUNCTION L_vap 
     827         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ') 
     828         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
     829         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ') 
     830      ENDIF 
     831      ! 
     832   END SUBROUTINE blk_oce_2 
     833 
    683834 
    684835#if defined key_si3 
    … …  
    686837   !!   'key_si3'                                       SI3 sea-ice model 
    687838   !!---------------------------------------------------------------------- 
    688    !!   blk_ice_tau : provide the air-ice stress 
    689    !!   blk_ice_flx : provide the heat and mass fluxes at air-ice interface 
     839   !!   blk_ice_1  : provide the air-ice stress 
     840   !!   blk_ice_2  : provide the heat and mass fluxes at air-ice interface 
    690841   !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    691842   !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    692    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag  
     843   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    693844   !!---------------------------------------------------------------------- 
    694845 
    695    SUBROUTINE blk_ice_tau 
    696       !!--------------------------------------------------------------------- 
    697       !!                     ***  ROUTINE blk_ice_tau  *** 
     846   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs 
     847      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs 
     848      !!--------------------------------------------------------------------- 
     849      !!                     ***  ROUTINE blk_ice_1  *** 
    698850      !! 
    699851      !! ** Purpose :   provide the surface boundary condition over sea-ice 
    … …  
    703855      !!                NB: ice drag coefficient is assumed to be a constant 
    704856      !!--------------------------------------------------------------------- 
     857      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pslp    ! sea-level pressure [Pa] 
     858      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndi   ! atmospheric wind at T-point [m/s] 
     859      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s] 
     860      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s] 
     861      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s] 
     862      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s] 
     863      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! " 
     864      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptsui   ! sea-ice surface temperature [K] 
     865      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   putaui  ! if ln_blk 
     866      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pvtaui  ! if ln_blk 
     867      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pseni   ! if ln_abl 
     868      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl 
     869      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl 
     870      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl 
     871      ! 
    705872      INTEGER  ::   ji, jj    ! dummy loop indices 
    706       REAL(wp) ::   zwndi_f , zwndj_f, zwnorm_f   ! relative wind module and components at F-point 
    707873      REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point 
    708       REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa     ! transfer coefficient for momentum      (tau) 
    709       !!--------------------------------------------------------------------- 
    710       ! 
    711       ! set transfer coefficients to default sea-ice values 
    712       Cd_atm(:,:) = Cd_ice 
    713       Ch_atm(:,:) = Cd_ice 
    714       Ce_atm(:,:) = Cd_ice 
    715  
    716       wndm_ice(:,:) = 0._wp      !!gm brutal.... 
     874      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature 
     875      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays 
     876      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau) 
     877      !!--------------------------------------------------------------------- 
     878      ! 
    717879 
    718880      ! ------------------------------------------------------------ ! 
    … …  
    722884      DO jj = 2, jpjm1 
    723885         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    724             zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
    725             zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     886            zwndi_t = (  pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj  ) + puice(ji,jj) )  ) 
     887            zwndj_t = (  pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji  ,jj-1) + pvice(ji,jj) )  ) 
    726888            wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    727889         END DO 
    … …  
    731893      ! Make ice-atm. drag dependent on ice concentration 
    732894      IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations 
    733          CALL Cdn10_Lupkes2012( Cd_atm ) 
    734          Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical 
     895         CALL Cdn10_Lupkes2012( Cd_ice ) 
     896         Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical 
     897         Ce_ice(:,:) = Cd_ice(:,:) 
    735898      ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
    736          CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm )  
    737       ENDIF 
    738  
    739 !!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef. 
    740 !!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef. 
     899         CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice ) 
     900         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
     901      ENDIF 
     902 
     903      !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
     904      !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    741905 
    742906      ! local scalars ( place there for vector optimisation purposes) 
    743       ! Computing density of air! Way denser that 1.2 over sea-ice !!! 
    744       zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
    745  
    746       !!gm brutal.... 
    747       utau_ice  (:,:) = 0._wp 
    748       vtau_ice  (:,:) = 0._wp 
    749       !!gm end 
    750  
    751       ! ------------------------------------------------------------ ! 
    752       !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
    753       ! ------------------------------------------------------------ ! 
    754       ! C-grid ice dynamics :   U & V-points (same as ocean) 
    755       DO jj = 2, jpjm1 
    756          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    757             utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            & 
    758                &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
    759             vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            & 
    760                &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
     907      !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI) 
     908      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
     909 
     910      IF( ln_blk ) THEN 
     911         ! ------------------------------------------------------------ ! 
     912         !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
     913         ! ------------------------------------------------------------ ! 
     914         ! C-grid ice dynamics :   U & V-points (same as ocean) 
     915         DO jj = 2, jpjm1 
     916            DO ji = fs_2, fs_jpim1   ! vect. opt. 
     917               putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             & 
     918                  &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          & 
     919                  &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) ) 
     920               pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             & 
     921                  &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          & 
     922                  &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) ) 
     923            END DO 
    761924         END DO 
    762       END DO 
    763       CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    764       ! 
    765       ! 
    766       IF(ln_ctl) THEN 
    767          CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ') 
    768          CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ') 
    769       ENDIF 
    770       ! 
    771    END SUBROUTINE blk_ice_tau 
    772  
    773  
    774    SUBROUTINE blk_ice_flx( ptsu, phs, phi, palb ) 
    775       !!--------------------------------------------------------------------- 
    776       !!                     ***  ROUTINE blk_ice_flx  *** 
     925         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. ) 
     926         ! 
     927         IF(ln_ctl)   CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   & 
     928            &                     , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' ) 
     929      ELSE 
     930         zztmp1 = 11637800.0_wp 
     931         zztmp2 =    -5897.8_wp 
     932         DO jj = 1, jpj 
     933            DO ji = 1, jpi 
     934               pcd_dui(ji,jj) = zcd_dui (ji,jj) 
     935               pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
     936               pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
     937               zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??) 
     938               pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj) 
     939            END DO 
     940         END DO 
     941      ENDIF 
     942      ! 
     943      IF(ln_ctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ') 
     944      ! 
     945   END SUBROUTINE blk_ice_1 
     946 
     947 
     948   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  ) 
     949      !!--------------------------------------------------------------------- 
     950      !!                     ***  ROUTINE blk_ice_2  *** 
    777951      !! 
    778952      !! ** Purpose :   provide the heat and mass fluxes at air-ice interface 
    … …  
    784958      !! caution : the net upward water flux has with mm/day unit 
    785959      !!--------------------------------------------------------------------- 
    786       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature 
     960      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature [K] 
    787961      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness 
    788962      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    789963      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies) 
     964      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair 
     965      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi 
     966      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp 
     967      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw 
     968      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec 
     969      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow 
    790970      !! 
    791971      INTEGER  ::   ji, jj, jl               ! dummy loop indices 
    792972      REAL(wp) ::   zst3                     ! local variable 
    793973      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    794       REAL(wp) ::   zztmp, z1_rLsub           !   -      - 
     974      REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      - 
    795975      REAL(wp) ::   zfr1, zfr2               ! local variables 
    796976      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
    … …  
    800980      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice 
    801981      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3) 
    802       REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa 
     982      REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB 
    803983      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2 
    804984      !!--------------------------------------------------------------------- 
    805985      ! 
    806       zcoef_dqlw = 4.0 * 0.95 * Stef             ! local scalars 
    807       zcoef_dqla = -Ls * 11637800. * (-5897.8) 
    808       ! 
    809       zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
     986      zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars 
     987      zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD! 
     988      ! 
     989      SELECT CASE( nhumi ) 
     990      CASE( np_humi_sph ) 
     991         zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity! 
     992      CASE( np_humi_dpt ) 
     993         zqair(:,:) = q_sat( phumi(:,:), pslp ) 
     994      CASE( np_humi_rlh ) 
     995         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
     996      END SELECT 
    810997      ! 
    811998      zztmp = 1. / ( 1. - albo ) 
    812       WHERE( ptsu(:,:,:) /= 0._wp )   ;   z1_st(:,:,:) = 1._wp / ptsu(:,:,:) 
    813       ELSEWHERE                       ;   z1_st(:,:,:) = 0._wp 
     999      WHERE( ptsu(:,:,:) /= 0._wp ) 
     1000         z1_st(:,:,:) = 1._wp / ptsu(:,:,:) 
     1001      ELSEWHERE 
     1002         z1_st(:,:,:) = 0._wp 
    8141003      END WHERE 
    8151004      !                                     ! ========================== ! 
    … …  
    8251014               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    8261015               ! Long  Wave (lw) 
    827                z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     1016               z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    8281017               ! lw sensitivity 
    8291018               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 
    … …  
    8331022               ! ----------------------------! 
    8341023 
    835                ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau 
     1024               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 
    8361025               ! Sensible Heat 
    837                z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1)) 
     1026               z_qsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj)) 
    8381027               ! Latent Heat 
    839                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  & 
    840                   &                ( 11637800. * EXP( -5897.8 * z1_st(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) ) 
     1028               zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) ) 
     1029               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
     1030                  &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) ) 
    8411031               ! Latent heat sensitivity for ice (Dqla/Dt) 
    8421032               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    843                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  & 
    844                      &                 z1_st(ji,jj,jl)*z1_st(ji,jj,jl) * EXP(-5897.8 * z1_st(ji,jj,jl)) 
     1033                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
     1034                     &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2 
    8451035               ELSE 
    8461036                  dqla_ice(ji,jj,jl) = 0._wp 
    … …  
    8481038 
    8491039               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    850                z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) 
     1040               z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) 
    8511041 
    8521042               ! ----------------------------! 
    … …  
    8631053      END DO 
    8641054      ! 
    865       tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s] 
    866       sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s] 
    867       CALL iom_put( 'snowpre', sprecip )                    ! Snow precipitation 
    868       CALL iom_put( 'precip' , tprecip )                    ! Total precipitation 
     1055      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s] 
     1056      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s] 
     1057      CALL iom_put( 'snowpre', sprecip )                  ! Snow precipitation 
     1058      CALL iom_put( 'precip' , tprecip )                  ! Total precipitation 
    8691059 
    8701060      ! --- evaporation --- ! 
    … …  
    8831073      ! --- heat flux associated with emp --- ! 
    8841074      qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst 
    885          &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
     1075         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp               & ! liquid precip at Tair 
    8861076         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
    887          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
     1077         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    8881078      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
    889          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
     1079         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    8901080 
    8911081      ! --- total solar and non solar fluxes --- ! 
    … …  
    8951085 
    8961086      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    897       qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
     1087      qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    8981088 
    8991089      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
    9001090      DO jl = 1, jpl 
    9011091         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) ) 
    902          !                         ! But we do not have Tice => consider it at 0degC => evap=0  
     1092         !                         ! But we do not have Tice => consider it at 0degC => evap=0 
    9031093      END DO 
    9041094 
    … …  
    9071097      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    9081098      ! 
    909       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
     1099      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
    9101100         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    9111101      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    9121102         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    9131103      ELSEWHERE                                                         ! zero when hs>0 
    914          qtr_ice_top(:,:,:) = 0._wp  
     1104         qtr_ice_top(:,:,:) = 0._wp 
    9151105      END WHERE 
    9161106      ! 
    … …  
    9441134      ENDIF 
    9451135      ! 
    946    END SUBROUTINE blk_ice_flx 
    947     
     1136   END SUBROUTINE blk_ice_2 
     1137 
    9481138 
    9491139   SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi ) 
    … …  
    9541144      !!                to force sea ice / snow thermodynamics 
    9551145      !!                in the case conduction flux is emulated 
    956       !!                 
     1146      !! 
    9571147      !! ** Method  :   compute surface energy balance assuming neglecting heat storage 
    9581148      !!                following the 0-layer Semtner (1976) approach 
    … …  
    9791169      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zgfac   ! enhanced conduction factor 
    9801170      !!--------------------------------------------------------------------- 
    981        
     1171 
    9821172      ! -------------------------------------! 
    9831173      !      I   Enhanced conduction factor  ! 
    … …  
    9871177      ! 
    9881178      zgfac(:,:,:) = 1._wp 
    989        
     1179 
    9901180      IF( ld_virtual_itd ) THEN 
    9911181         ! 
    … …  
    9931183         zfac2 = EXP(1._wp) * 0.5_wp * zepsilon 
    9941184         zfac3 = 2._wp / zepsilon 
    995          !    
    996          DO jl = 1, jpl                 
     1185         ! 
     1186         DO jl = 1, jpl 
    9971187            DO jj = 1 , jpj 
    9981188               DO ji = 1, jpi 
    … …  
    10021192            END DO 
    10031193         END DO 
    1004          !       
    1005       ENDIF 
    1006        
     1194         ! 
     1195      ENDIF 
     1196 
    10071197      ! -------------------------------------------------------------! 
    10081198      !      II   Surface temperature and conduction flux            ! 
    … …  
    10141204         DO jj = 1 , jpj 
    10151205            DO ji = 1, jpi 
    1016                !                     
     1206               ! 
    10171207               zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness 
    10181208                  &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 
    … …  
    10311221               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 
    10321222               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) )  & 
    1033                              &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
     1223                  &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
    10341224 
    10351225               ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- ! 
    1036                hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl)  
     1226               hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
    10371227 
    10381228            END DO 
    10391229         END DO 
    10401230         ! 
    1041       END DO  
    1042       !       
     1231      END DO 
     1232      ! 
    10431233   END SUBROUTINE blk_ice_qcn 
    1044     
    1045  
    1046    SUBROUTINE Cdn10_Lupkes2012( Cd ) 
     1234 
     1235 
     1236   SUBROUTINE Cdn10_Lupkes2012( pcd ) 
    10471237      !!---------------------------------------------------------------------- 
    10481238      !!                      ***  ROUTINE  Cdn10_Lupkes2012  *** 
    10491239      !! 
    1050       !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m  
     1240      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
    10511241      !!                 to make it dependent on edges at leads, melt ponds and flows. 
    10521242      !!                 After some approximations, this can be resumed to a dependency 
    10531243      !!                 on ice concentration. 
    1054       !!                 
     1244      !! 
    10551245      !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50) 
    10561246      !!                 with the highest level of approximation: level4, eq.(59) 
    … …  
    10641254      !! 
    10651255      !!                 This new drag has a parabolic shape (as a function of A) starting at 
    1066       !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5  
     1256      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
    10671257      !!                 and going down to Cdi(say 1.4e-3) for A=1 
    10681258      !! 
    … …  
    10741264      !! 
    10751265      !!---------------------------------------------------------------------- 
    1076       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
     1266      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd 
    10771267      REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp 
    10781268      REAL(wp), PARAMETER ::   znu   = 1._wp 
    … …  
    10891279 
    10901280      ! ice-atm drag 
    1091       Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag 
    1092          &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
    1093        
     1281      pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag 
     1282         &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
     1283 
    10941284   END SUBROUTINE Cdn10_Lupkes2012 
    10951285 
    10961286 
    1097    SUBROUTINE Cdn10_Lupkes2015( Cd, Ch ) 
     1287   SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch ) 
    10981288      !!---------------------------------------------------------------------- 
    10991289      !!                      ***  ROUTINE  Cdn10_Lupkes2015  *** 
    11001290      !! 
    11011291      !! ** pUrpose :    Alternative turbulent transfert coefficients formulation 
    1102       !!                 between sea-ice and atmosphere with distinct momentum  
    1103       !!                 and heat coefficients depending on sea-ice concentration  
     1292      !!                 between sea-ice and atmosphere with distinct momentum 
     1293      !!                 and heat coefficients depending on sea-ice concentration 
    11041294      !!                 and atmospheric stability (no meltponds effect for now). 
    1105       !!                 
     1295      !! 
    11061296      !! ** Method :     The parameterization is adapted from Lupkes et al. (2015) 
    11071297      !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme, 
    11081298      !!                 it considers specific skin and form drags (Andreas et al. 2010) 
    1109       !!                 to compute neutral transfert coefficients for both heat and  
     1299      !!                 to compute neutral transfert coefficients for both heat and 
    11101300      !!                 momemtum fluxes. Atmospheric stability effect on transfert 
    11111301      !!                 coefficient is also taken into account following Louis (1979). 
    … …  
    11161306      !!---------------------------------------------------------------------- 
    11171307      ! 
    1118       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
    1119       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch 
    1120       REAL(wp), DIMENSION(jpi,jpj)            ::   ztm_su, zst, zqo_sat, zqi_sat 
     1308      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K] 
     1309      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa] 
     1310      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient 
     1311      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient 
     1312      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat 
    11211313      ! 
    11221314      ! ECHAM6 constants 
    … …  
    11461338      !!---------------------------------------------------------------------- 
    11471339 
    1148       ! mean temperature 
    1149       WHERE( at_i_b(:,:) > 1.e-20 )   ;   ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:) 
    1150       ELSEWHERE                       ;   ztm_su(:,:) = rt0 
    1151       ENDWHERE 
    1152        
    11531340      ! Momentum Neutral Transfert Coefficients (should be a constant) 
    11541341      zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40 
    11551342      zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7 
    1156       zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details) 
     1343      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 
    11571344      !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32) 
    11581345 
    11591346      ! Heat Neutral Transfert Coefficients 
    1160       zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 (cf Lupkes email for details) 
    1161       
     1347      zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 
     1348 
    11621349      ! Atmospheric and Surface Variables 
    11631350      zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin 
    1164       zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)   , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg] 
    1165       zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg] 
     1351      zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg] 
     1352      zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg] 
    11661353      ! 
    11671354      DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility 
    … …  
    11691356            ! Virtual potential temperature [K] 
    11701357            zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 
    1171             zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
     1358            zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
    11721359            zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu 
    1173              
     1360 
    11741361            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead) 
    11751362            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean 
    11761363            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice 
    1177              
     1364 
    11781365            ! Momentum and Heat Neutral Transfert Coefficients 
    11791366            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40 
    1180             zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53  
    1181                         
    1182             ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead) 
     1367            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
     1368 
     1369            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?) 
    11831370            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
    1184             z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details) 
     1371            z0i = z0_skin_ice                                             ! over ice 
    11851372            IF( zrib_o <= 0._wp ) THEN 
    11861373               zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10 
    … …  
    11911378               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28 
    11921379            ENDIF 
    1193              
     1380 
    11941381            IF( zrib_i <= 0._wp ) THEN 
    11951382               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9 
    … …  
    11991386               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27 
    12001387            ENDIF 
    1201              
     1388 
    12021389            ! Momentum Transfert Coefficients (Eq. 38) 
    1203             Cd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
     1390            pcd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
    12041391               &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    1205              
     1392 
    12061393            ! Heat Transfert Coefficients (Eq. 49) 
    1207             Ch(ji,jj) = zChn_skin_ice *   zfhi +  & 
     1394            pch(ji,jj) = zChn_skin_ice *   zfhi +  & 
    12081395               &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    12091396            ! 
    12101397         END DO 
    12111398      END DO 
    1212       CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. ) 
     1399      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. ) 
    12131400      ! 
    12141401   END SUBROUTINE Cdn10_Lupkes2015 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r10069 r12154  
    11MODULE sbcblk_algo_ecmwf 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcblk_algo_ecmwf  *** 
    4    !! Computes turbulent components of surface fluxes 
    5    !!         according to the method in IFS of the ECMWF model 
    6    !! 
     3   !!                   ***  MODULE  sbcblk_algo_ecmwf  *** 
     4   !! Computes: 
    75   !!   * bulk transfer coefficients C_D, C_E and C_H 
    86   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    … …  
    108   !!   => all these are used in bulk formulas in sbcblk.F90 
    119   !! 
    12    !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 31r2) 
     10   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 40r1) 
    1311   !!         based on IFS doc (avaible online on the ECMWF's website) 
    1412   !! 
     13   !!       Routine turb_ecmwf maintained and developed in AeroBulk 
     14   !!                     (https://github.com/brodeau/aerobulk) 
    1515   !! 
    16    !!       Routine turb_ecmwf maintained and developed in AeroBulk 
    17    !!                     (http://aerobulk.sourceforge.net/) 
    18    !! 
    19    !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     16   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    2017   !!---------------------------------------------------------------------- 
    2118   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
    … …  
    4138 
    4239   USE sbc_oce         ! Surface boundary condition: ocean fields 
     40   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     41   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB 
    4342 
    4443   IMPLICIT NONE 
    4544   PRIVATE 
    4645 
    47    PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90 
    48  
    49    !                   !! ECMWF own values for given constants, taken form IFS documentation... 
     46   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF 
     47 
     48   !! ECMWF own values for given constants, taken form IFS documentation... 
    5049   REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!! 
    5150   !                                          !    =>  Usually 0.011 for moderate winds) 
    5251   REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1 
    5352   REAL(wp), PARAMETER ::   Beta0    = 1.     ! gustiness parameter ( = 1.25 in COAREv3) 
    54    REAL(wp), PARAMETER ::   rctv0    = 0.608  ! constant to obtain virtual temperature... 
    55    REAL(wp), PARAMETER ::   Cp_dry = 1005.0   ! Specic heat of dry air, constant pressure      [J/K/kg] 
    56    REAL(wp), PARAMETER ::   Cp_vap = 1860.0   ! Specic heat of water vapor, constant pressure  [J/K/kg] 
    5753   REAL(wp), PARAMETER ::   alpha_M = 0.11    ! For roughness length (smooth surface term) 
    5854   REAL(wp), PARAMETER ::   alpha_H = 0.40    ! (Chapter 3, p.34, IFS doc Cy31r1) 
    5955   REAL(wp), PARAMETER ::   alpha_Q = 0.62    ! 
     56 
     57   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     58 
    6059   !!---------------------------------------------------------------------- 
    6160CONTAINS 
    6261 
    63    SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   & 
    64       &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         & 
    65       &                   Cdn, Chn, Cen                           ) 
    66       !!---------------------------------------------------------------------------------- 
    67       !!                      ***  ROUTINE  turb_ecmwf  *** 
    68       !! 
    69       !!            2015: L. Brodeau (brodeau@gmail.com) 
    70       !! 
    71       !! ** Purpose :   Computes turbulent transfert coefficients of surface 
    72       !!                fluxes according to IFS doc. (cycle 31) 
    73       !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
    74       !! 
    75       !! ** Method : Monin Obukhov Similarity Theory 
     62 
     63   SUBROUTINE sbcblk_algo_ecmwf_init(l_use_cs, l_use_wl) 
     64      !!--------------------------------------------------------------------- 
     65      !!                  ***  FUNCTION sbcblk_algo_ecmwf_init  *** 
    7666      !! 
    7767      !! INPUT : 
    7868      !! ------- 
     69      !!    * l_use_cs : use the cool-skin parameterization 
     70      !!    * l_use_wl : use the warm-layer parameterization 
     71      !!--------------------------------------------------------------------- 
     72      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization 
     73      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization 
     74      INTEGER :: ierr 
     75      !!--------------------------------------------------------------------- 
     76      IF( l_use_wl ) THEN 
     77         ierr = 0 
     78         ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) 
     79         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' ) 
     80         dT_wl(:,:)  = 0._wp 
     81         Hz_wl(:,:)  = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars) 
     82      ENDIF 
     83      IF( l_use_cs ) THEN 
     84         ierr = 0 
     85         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) 
     86         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' ) 
     87         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction 
     88      ENDIF 
     89   END SUBROUTINE sbcblk_algo_ecmwf_init 
     90 
     91 
     92 
     93   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
     94      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           & 
     95      &                      Cdn, Chn, Cen,                                           & 
     96      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
     97      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
     98      !!---------------------------------------------------------------------- 
     99      !!                      ***  ROUTINE  turb_ecmwf  *** 
     100      !! 
     101      !! ** Purpose :   Computes turbulent transfert coefficients of surface 
     102      !!                fluxes according to IFS doc. (cycle 45r1) 
     103      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
     104      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas 
     105      !! 
     106      !!                Applies the cool-skin warm-layer correction of the SST to T_s 
     107      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave 
     108      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp) 
     109      !!                are provided as (optional) arguments! 
     110      !! 
     111      !! INPUT : 
     112      !! ------- 
     113      !!    *  kt   : current time step (starts at 1) 
    79114      !!    *  zt   : height for temperature and spec. hum. of air            [m] 
    80       !!    *  zu   : height for wind speed (generally 10m)                   [m] 
    81       !!    *  U_zu : scalar wind speed at 10m                                [m/s] 
    82       !!    *  sst  : SST                                                     [K] 
     115      !!    *  zu   : height for wind speed (usually 10m)                     [m] 
    83116      !!    *  t_zt : potential air temperature at zt                         [K] 
    84       !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg] 
    85117      !!    *  q_zt : specific humidity of air at zt                          [kg/kg] 
    86       !! 
     118      !!    *  U_zu : scalar wind speed at zu                                 [m/s] 
     119      !!    * l_use_cs : use the cool-skin parameterization 
     120      !!    * l_use_wl : use the warm-layer parameterization 
     121      !! 
     122      !! INPUT/OUTPUT: 
     123      !! ------------- 
     124      !!    *  T_s  : always "bulk SST" as input                              [K] 
     125      !!              -> unchanged "bulk SST" as output if CSWL not used      [K] 
     126      !!              -> skin temperature as output if CSWL used              [K] 
     127      !! 
     128      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg] 
     129      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True) 
     130      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False) 
     131      !! 
     132      !! OPTIONAL INPUT: 
     133      !! --------------- 
     134      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2] 
     135      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2] 
     136      !!    *  slp    : sea-level pressure                                    [Pa] 
     137      !! 
     138      !! OPTIONAL OUTPUT: 
     139      !! ---------------- 
     140      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K] 
     141      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K] 
     142      !!    * pHz_wl  : thickness of warm-layer                               [m] 
    87143      !! 
    88144      !! OUTPUT : 
    … …  
    93149      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    94150      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    95       !!    *  U_blk  : bulk wind at 10m                                      [m/s] 
    96       !! 
    97       !! 
    98       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    99       !!---------------------------------------------------------------------------------- 
     151      !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     152      !! 
     153      !! 
     154      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     155      !!---------------------------------------------------------------------------------- 
     156      INTEGER,  INTENT(in   )                     ::   kt       ! current time step 
    100157      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m] 
    101158      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m] 
    102       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin] 
     159      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin] 
    103160      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin] 
    104       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg] 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg] 
     161      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg] 
     162      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg] 
    106163      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s] 
     164      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization 
     165      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization 
    107166      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    108167      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
    … …  
    110169      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    111170      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    112       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     171      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    113172      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114173      ! 
     174      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
     175      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
     176      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa] 
     177      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs 
     178      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K] 
     179      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
     180      ! 
    115181      INTEGER :: j_itt 
    116       LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    117       INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
    118       ! 
    119       REAL(wp), DIMENSION(jpi,jpj) ::   u_star, t_star, q_star,   & 
    120          &  dt_zu, dq_zu,    & 
    121          &  znu_a,           & !: Nu_air, Viscosity of air 
    122          &  Linv,            & !: 1/L (inverse of Monin Obukhov length... 
    123          &  z0, z0t, z0q 
    124       REAL(wp), DIMENSION(jpi,jpj) ::   func_m, func_h 
    125       REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2 
    126       !!---------------------------------------------------------------------------------- 
    127       ! 
    128       ! Identical first gess as in COARE, with IFS parameter values though 
    129       ! 
     182      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
     183      ! 
     184      REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star 
     185      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu      
     186      REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 
     187      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length... 
     188      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 
     189      ! 
     190      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst  ! to back up the initial bulk SST 
     191      ! 
     192      REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h 
     193      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 
     194      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 
     195      !!---------------------------------------------------------------------------------- 
     196 
     197      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
     198 
    130199      l_zt_equal_zu = .FALSE. 
    131       IF( ABS(zu - zt) < 0.01 )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
    132  
    133  
     200      IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     201 
     202      !! Initializations for cool skin and warm layer: 
     203      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) & 
     204         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' ) 
     205 
     206      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) & 
     207         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' ) 
     208 
     209      IF( l_use_cs .OR. l_use_wl ) THEN 
     210         ALLOCATE ( zsst(jpi,jpj) ) 
     211         zsst = T_s ! backing up the bulk SST 
     212         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction 
     213         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s 
     214      ENDIF 
     215 
     216 
     217      ! Identical first gess as in COARE, with IFS parameter values though... 
     218      ! 
    134219      !! First guess of temperature and humidity at height zu: 
    135       t_zu = MAX( t_zt , 0.0 )   ! who knows what's given on masked-continental regions... 
    136       q_zu = MAX( q_zt , 1.e-6)   !               " 
     220      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
     221      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    137222 
    138223      !! Pot. temp. difference (and we don't want it to be 0!) 
    139       dt_zu = t_zu - sst   ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.e-6), dt_zu ) 
    140       dq_zu = q_zu - ssq   ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.e-9), dq_zu ) 
    141  
    142       znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    143  
    144       ztmp2 = 0.5 * 0.5 ! initial guess for wind gustiness contribution 
    145       U_blk = SQRT(U_zu*U_zu + ztmp2) 
    146  
    147       ! z0     = 0.0001 
    148       ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0 
    149       ztmp0   = LOG(zu*ztmp2) 
    150       ztmp1   = LOG(10.*ztmp2) 
    151       u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    152  
    153       z0     = charn0*u_star*u_star/grav + 0.11*znu_a/u_star 
    154       z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t ! 
     224      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu ) 
     225      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu ) 
     226 
     227      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
     228 
     229      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     230 
     231      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
     232      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
     233      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     234 
     235      z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     236      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
     237 
     238      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) ) 
     239      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    155240 
    156241      Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    157242 
    158       ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd 
    159  
    160       ztmp2 = Ri_bulk( zu, t_zu, dt_zu, q_zu, dq_zu, U_blk )   ! Ribu = Bulk Richardson number 
    161  
    162       !! First estimate of zeta_u, depending on the stability, ie sign of Ribu (ztmp2): 
    163       ztmp1 = 0.5 + SIGN( 0.5 , ztmp2 ) 
     243      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
     244 
     245      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     246 
     247      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
     248      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    164249      func_m = ztmp0*ztmp2 ! temporary array !! 
    165       !!             Ribu < 0                                 Ribu > 0   Beta = 1.25 
    166       func_h = (1.-ztmp1)*(func_m/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &  ! temporary array !!! func_h == zeta_u 
    167          &  +     ztmp1*(func_m*(1. + 27./9.*ztmp2/ztmp0)) 
     250      func_h = (1._wp-ztmp1) * (func_m/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 ! temporary array !!! func_h == zeta_u 
     251         &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0 
     252      !#LB: should make sure that the "func_m" of "27./9.*ztmp2/func_m" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
    168253 
    169254      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    170       ztmp0   =        vkarmn/(LOG(zu*z0t) - psi_h_ecmwf(func_h)) 
    171  
    172       u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) 
     255      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h)) 
     256 
     257      u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    173258      t_star = dt_zu*ztmp0 
    174259      q_star = dq_zu*ztmp0 
    175260 
    176       ! What's need to be done if zt /= zu: 
     261      ! What needs to be done if zt /= zu: 
    177262      IF( .NOT. l_zt_equal_zu ) THEN 
    178          ! 
    179263         !! First update of values at zu (or zt for wind) 
    180264         ztmp0 = psi_h_ecmwf(func_h) - psi_h_ecmwf(zt*func_h/zu)    ! zt*func_h/zu == zeta_t 
    181          ztmp1 = log(zt/zu) + ztmp0 
     265         ztmp1 = LOG(zt/zu) + ztmp0 
    182266         t_zu = t_zt - t_star/vkarmn*ztmp1 
    183267         q_zu = q_zt - q_star/vkarmn*ztmp1 
    184          q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity : 
    185  
    186          dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu ) 
    187          dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu ) 
     268         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity : 
    188269         ! 
     270         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu ) 
     271         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu ) 
    189272      ENDIF 
    190273 
    … …  
    194277 
    195278      !! First guess of inverse of Monin-Obukov length (1/L) : 
    196       ztmp0 = (1. + rctv0*q_zu)  ! the factor to apply to temp. to get virt. temp... 
    197       Linv  =  grav*vkarmn*(t_star*ztmp0 + rctv0*t_zu*q_star) / ( u_star*u_star * t_zu*ztmp0 ) 
     279      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star ) 
    198280 
    199281      !! Functions such as  u* = U_blk*vkarmn/func_m 
    200       ztmp1 = zu + z0 
    201       ztmp0 = ztmp1*Linv 
    202       func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv) 
    203       func_h = LOG(ztmp1*z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(1./z0t*Linv) 
    204  
     282      ztmp0 = zu*Linv 
     283      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv) 
     284      func_h = LOG(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
    205285 
    206286      !! ITERATION BLOCK 
    207       !! *************** 
    208  
    209287      DO j_itt = 1, nb_itt 
    210288 
    211289         !! Bulk Richardson Number at z=zu (Eq. 3.25) 
    212          ztmp0 = Ri_bulk(zu, t_zu, dt_zu, q_zu, dq_zu, U_blk) 
     290         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
    213291 
    214292         !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) : 
    215          Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3, p.33, IFS doc - Cy31r1 
     293         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1 
     294         !! Note: it is slightly different that the L we would get with the usual 
     295         Linv = SIGN( MIN(ABS(Linv),200._wp), Linv ) ! (prevent FPE from stupid values from masked region later on...) 
    216296 
    217297         !! Update func_m with new Linv: 
    218          ztmp1 = zu + z0 
    219          func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp1*Linv) + psi_m_ecmwf(z0*Linv) 
     298         func_m = LOG(zu) -LOG(z0) - psi_m_ecmwf(zu*Linv) + psi_m_ecmwf(z0*Linv) ! LB: should be "zu+z0" rather than "zu" alone, but z0 is tiny wrt zu! 
    220299 
    221300         !! Need to update roughness lengthes: 
    … …  
    223302         ztmp2  = u_star*u_star 
    224303         ztmp1  = znu_a/u_star 
    225          z0    = alpha_M*ztmp1 + charn0*ztmp2/grav 
    226          z0t    = alpha_H*ztmp1                              ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
    227          z0q    = alpha_Q*ztmp1 
    228  
    229          !! Update wind at 10m taking into acount convection-related wind gustiness: 
    230          ! Only true when unstable (L<0) => when ztmp0 < 0 => - !!! 
    231          ztmp2 = ztmp2 * (MAX(-zi0*Linv/vkarmn,0.))**(2./3.) ! => w*^2  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1) 
    232          !! => equivalent using Beta=1 (gustiness parameter, 1.25 for COARE, also zi0=600 in COARE..) 
    233          U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)              ! eq.3.17, Chap.3, p.32, IFS doc - Cy31r1 
     304         z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp) 
     305         z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
     306         z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp) 
     307 
     308         !! Update wind at zu with convection-related wind gustiness in unstable conditions (Chap. 3.2, IFS doc - Cy40r1, Eq.3.17 and Eq.3.18 + Eq.3.8) 
     309         ztmp2 = Beta0*Beta0*ztmp2*(MAX(-zi0*Linv/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1) 
     310         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
     311         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    234312         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
    235313 
    … …  
    238316         !! as well the air-sea differences: 
    239317         IF( .NOT. l_zt_equal_zu ) THEN 
    240  
    241318            !! Arrays func_m and func_h are free for a while so using them as temporary arrays... 
    242             func_h = psi_h_ecmwf((zu+z0)*Linv) ! temporary array !!! 
    243             func_m = psi_h_ecmwf((zt+z0)*Linv) ! temporary array !!! 
     319            func_h = psi_h_ecmwf(zu*Linv) ! temporary array !!! 
     320            func_m = psi_h_ecmwf(zt*Linv) ! temporary array !!! 
    244321 
    245322            ztmp2  = psi_h_ecmwf(z0t*Linv) 
    246323            ztmp0  = func_h - ztmp2 
    247             ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0t) - ztmp0) 
     324            ztmp1  = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0) 
    248325            t_star = dt_zu*ztmp1 
    249326            ztmp2  = ztmp0 - func_m + ztmp2 
    … …  
    253330            ztmp2  = psi_h_ecmwf(z0q*Linv) 
    254331            ztmp0  = func_h - ztmp2 
    255             ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0q) - ztmp0) 
     332            ztmp1  = vkarmn/(LOG(zu) - LOG(z0q) - ztmp0) 
    256333            q_star = dq_zu*ztmp1 
    257334            ztmp2  = ztmp0 - func_m + ztmp2 
    258             ztmp1  = log(zt/zu) + ztmp2 
     335            ztmp1  = LOG(zt/zu) + ztmp2 
    259336            q_zu   = q_zt - q_star/vkarmn*ztmp1 
    260  
    261             dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu ) 
    262             dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu ) 
    263  
    264          END IF 
     337         ENDIF 
    265338 
    266339         !! Updating because of updated z0 and z0t and new Linv... 
    267          ztmp1 = zu + z0 
    268          ztmp0 = ztmp1*Linv 
    269          func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv) 
    270          func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
    271  
    272       END DO 
     340         ztmp0 = zu*Linv 
     341         func_m = log(zu) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv) 
     342         func_h = log(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
     343 
     344 
     345         IF( l_use_cs ) THEN 
     346            !! Cool-skin contribution 
     347 
     348            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     349               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0 
     350 
     351            CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst )  ! Qnsol -> ztmp1 
     352 
     353            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1) 
     354            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 
     355            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
     356 
     357         ENDIF 
     358 
     359         IF( l_use_wl ) THEN 
     360            !! Warm-layer contribution 
     361            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     362               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2 
     363            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) 
     364            !! Updating T_s and q_s !!! 
     365            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) ! 
     366            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) 
     367            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
     368         ENDIF 
     369 
     370         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN 
     371            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu ) 
     372            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu ) 
     373         ENDIF 
     374 
     375      END DO !DO j_itt = 1, nb_itt 
    273376 
    274377      Cd = vkarmn*vkarmn/(func_m*func_m) 
    275378      Ch = vkarmn*vkarmn/(func_m*func_h) 
    276       ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
    277       Ce = vkarmn*vkarmn/(func_m*ztmp1) 
    278  
    279       ztmp1 = zu + z0 
    280       Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
    281       Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
    282       Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q)) 
    283  
    284    END SUBROUTINE TURB_ECMWF 
     379      ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
     380      Ce = vkarmn*vkarmn/(func_m*ztmp2) 
     381 
     382      Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 )) 
     383      Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t)) 
     384      Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q)) 
     385 
     386      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
     387      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl 
     388      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl 
     389 
     390      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst ) 
     391 
     392   END SUBROUTINE turb_ecmwf 
    285393 
    286394 
    … …  
    294402      !!         and L is M-O length 
    295403      !! 
    296       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     404      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    297405      !!---------------------------------------------------------------------------------- 
    298406      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf 
    … …  
    302410      REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 
    303411      !!---------------------------------------------------------------------------------- 
    304       ! 
    305412      DO jj = 1, jpj 
    306413         DO ji = 1, jpi 
    307414            ! 
    308             zzeta = MIN( pzeta(ji,jj) , 5. ) !! Very stable conditions (L positif and big!): 
     415            zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
    309416            ! 
    310417            ! Unstable (Paulson 1970): 
    311418            !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    312             zx = SQRT(ABS(1. - 16.*zzeta)) 
    313             ztmp = 1. + SQRT(zx) 
     419            zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
     420            ztmp = 1._wp + SQRT(zx) 
    314421            ztmp = ztmp*ztmp 
    315             psi_unst = LOG( 0.125*ztmp*(1. + zx) )   & 
    316                &       -2.*ATAN( SQRT(zx) ) + 0.5*rpi 
     422            psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
     423               &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
    317424            ! 
    318425            ! Unstable: 
    319426            ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    320             psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & 
    321                &       - zzeta - 2./3.*5./0.35 
     427            psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
     428               &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
    322429            ! 
    323430            ! Combining: 
    324             stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1 
    325             ! 
    326             psi_m_ecmwf(ji,jj) = (1. - stab) * psi_unst & ! (zzeta < 0) Unstable 
    327                &                +      stab  * psi_stab   ! (zzeta > 0) Stable 
     431            stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     432            ! 
     433            psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
     434               &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
    328435            ! 
    329436         END DO 
    330437      END DO 
    331       ! 
    332438   END FUNCTION psi_m_ecmwf 
    333439 
    334     
     440 
    335441   FUNCTION psi_h_ecmwf( pzeta ) 
    336442      !!---------------------------------------------------------------------------------- 
    … …  
    342448      !!         and L is M-O length 
    343449      !! 
    344       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     450      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    345451      !!---------------------------------------------------------------------------------- 
    346452      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf 
    … …  
    354460         DO ji = 1, jpi 
    355461            ! 
    356             zzeta = MIN(pzeta(ji,jj) , 5.)   ! Very stable conditions (L positif and big!): 
    357             ! 
    358             zx  = ABS(1. - 16.*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
     462            zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
     463            ! 
     464            zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
    359465            !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
    360466            ! Unstable (Paulson 1970) : 
    361             psi_unst = 2.*LOG(0.5*(1. + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
     467            psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    362468            ! 
    363469            ! Stable: 
    364             psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    365                &       - ABS(1. + 2./3.*zzeta)**1.5 - 2./3.*5./0.35 + 1.  
     470            psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
     471               &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
    366472            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
    367473            ! 
    368             stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1 
    369             ! 
    370             ! 
    371             psi_h_ecmwf(ji,jj) = (1. - stab) * psi_unst &   ! (zzeta < 0) Unstable 
    372                &                +    stab    * psi_stab     ! (zzeta > 0) Stable 
     474            stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     475            ! 
     476            ! 
     477            psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
     478               &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
    373479            ! 
    374480         END DO 
    375481      END DO 
    376       ! 
    377482   END FUNCTION psi_h_ecmwf 
    378483 
    379  
    380    FUNCTION Ri_bulk( pz, ptz, pdt, pqz, pdq, pub ) 
    381       !!---------------------------------------------------------------------------------- 
    382       !! Bulk Richardson number (Eq. 3.25 IFS doc) 
    383       !! 
    384       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    385       !!---------------------------------------------------------------------------------- 
    386       REAL(wp), DIMENSION(jpi,jpj) ::   Ri_bulk   ! 
    387       ! 
    388       REAL(wp)                    , INTENT(in) ::   pz    ! height above the sea        [m] 
    389       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptz   ! air temperature at pz m     [K] 
    390       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdt   ! ptz - sst                   [K] 
    391       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqz   ! air temperature at pz m [kg/kg] 
    392       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdq   ! pqz - ssq               [kg/kg] 
    393       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pub   ! bulk wind speed           [m/s] 
    394       !!---------------------------------------------------------------------------------- 
    395       ! 
    396       Ri_bulk =   grav*pz/(pub*pub)                                          & 
    397          &      * ( pdt/(ptz - 0.5_wp*(pdt + grav*pz/(Cp_dry+Cp_vap*pqz)))   & 
    398          &          + rctv0*pdq ) 
    399       ! 
    400    END FUNCTION Ri_bulk 
    401  
    402  
    403    FUNCTION visc_air(ptak) 
    404       !!---------------------------------------------------------------------------------- 
    405       !! Air kinetic viscosity (m^2/s) given from temperature in degrees... 
    406       !! 
    407       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    408       !!---------------------------------------------------------------------------------- 
    409       REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   ! 
    410       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K) 
    411       ! 
    412       INTEGER  ::   ji, jj      ! dummy loop indices 
    413       REAL(wp) ::   ztc, ztc2   ! local scalar 
    414       !!---------------------------------------------------------------------------------- 
    415       ! 
    416       DO jj = 1, jpj 
    417          DO ji = 1, jpi 
    418             ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C 
    419             ztc2 = ztc*ztc 
    420             visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc) 
    421          END DO 
    422       END DO 
    423       ! 
    424    END FUNCTION visc_air 
    425484 
    426485   !!====================================================================== 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcblk_algo_ncar.F90

    r10190 r12154  
    1111   !! 
    1212   !!       Routine turb_ncar maintained and developed in AeroBulk 
    13    !!                     (http://aerobulk.sourceforge.net/) 
     13   !!                     (https://github.com/brodeau/aerobulk/) 
    1414   !! 
    1515   !!                         L. Brodeau, 2015 
    … …  
    3838   USE lib_fortran     ! to use key_nosignedzero 
    3939 
     40   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4041 
    4142   IMPLICIT NONE 
    4243   PRIVATE 
    4344 
    44    PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90 
    45  
    46    !                              ! NCAR own values for given constants: 
    47    REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature... 
    48     
     45   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90 
     46 
     47   INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations 
     48 
    4949   !!---------------------------------------------------------------------- 
    5050CONTAINS 
    … …  
    6161      !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas 
    6262      !! 
    63       !! ** Method : Monin Obukhov Similarity Theory 
    64       !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10) 
    65       !! 
    66       !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008 
    67       !! 
    68       !! ** Last update: Laurent Brodeau, June 2014: 
    69       !!    - handles both cases zt=zu and zt/=zu 
    70       !!    - optimized: less 2D arrays allocated and less operations 
    71       !!    - better first guess of stability by checking air-sea difference of virtual temperature 
    72       !!       rather than temperature difference only... 
    73       !!    - added function "cd_neutral_10m" that uses the improved parametrization of 
    74       !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions! 
    75       !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them 
    76       !!      => 'vkarmn' and 'grav' 
    77       !! 
    78       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    7963      !! 
    8064      !! INPUT : 
    8165      !! ------- 
    8266      !!    *  zt   : height for temperature and spec. hum. of air            [m] 
    83       !!    *  zu   : height for wind speed (generally 10m)                   [m] 
    84       !!    *  U_zu : scalar wind speed at 10m                                [m/s] 
    85       !!    *  sst  : SST                                                     [K] 
     67      !!    *  zu   : height for wind speed (usually 10m)                     [m] 
     68      !!    *  sst  : bulk SST                                                [K] 
    8669      !!    *  t_zt : potential air temperature at zt                         [K] 
    8770      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg] 
    8871      !!    *  q_zt : specific humidity of air at zt                          [kg/kg] 
     72      !!    *  U_zu : scalar wind speed at zu                                 [m/s] 
    8973      !! 
    9074      !! 
    … …  
    9680      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    9781      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    98       !!    *  U_blk  : bulk wind at 10m                                      [m/s] 
     82      !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     83      !! 
     84      !! 
     85      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    9986      !!---------------------------------------------------------------------------------- 
    10087      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m] 
    … …  
    10390      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin] 
    10491      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg] 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg] 
     92      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg] 
    10693      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s] 
    10794      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    … …  
    11097      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    11198      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    112       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     99      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    113100      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114101      ! 
    115       INTEGER ::   j_itt 
    116       LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    117       INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
     102      INTEGER :: j_itt 
     103      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    118104      ! 
    119105      REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient 
    … …  
    126112      ! 
    127113      l_zt_equal_zu = .FALSE. 
    128       IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
    129  
    130       U_blk = MAX( 0.5 , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
     114      IF( ABS(zu - zt) < 0.01_wp )  l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     115 
     116      U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    131117 
    132118      !! First guess of stability: 
    133       ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt 
    134       stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
     119      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt 
     120      stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
    135121 
    136122      !! Neutral coefficients at 10m: 
    … …  
    139125         ztmp0   (:,:) = cdn_wave(:,:) 
    140126      ELSE 
    141          ztmp0 = cd_neutral_10m( U_blk ) 
     127      ztmp0 = cd_neutral_10m( U_blk ) 
    142128      ENDIF 
    143129 
    … …  
    146132      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    147133      Cd = ztmp0 
    148       Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 ) 
    149       Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 
     134      Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 ) 
     135      Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab)) 
    150136      stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd) 
    151137  
    152       IF( ln_cdgw )   Cen = Ce  ; Chn = Ch 
     138      IF( ln_cdgw ) THEN 
     139   Cen = Ce 
     140   Chn = Ch 
     141      ENDIF 
    153142 
    154143      !! Initializing values at z_u with z_t values: 
    155144      t_zu = t_zt   ;   q_zu = q_zt 
    156145 
    157       !!  * Now starting iteration loop 
    158       DO j_itt=1, nb_itt 
     146      !! ITERATION BLOCK 
     147      DO j_itt = 1, nb_itt 
    159148         ! 
    160149         ztmp1 = t_zu - sst   ! Updating air/sea differences 
    … …  
    162151 
    163152         ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
    164          ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
    165          ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    166  
    167          ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature 
     153         ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd)) 
     154         ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
     155         ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    168156 
    169157         ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
    170          ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk) 
    171          !                                                      ( Cd*U_blk*U_blk is U*^2 at zu ) 
    172  
     158         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 ) 
     159          
    173160         !! Stability parameters : 
    174          zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
     161         zeta_u   = zu*ztmp0 
     162         zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u ) 
    175163         zpsi_h_u = psi_h( zeta_u ) 
    176164 
    … …  
    178166         IF( .NOT. l_zt_equal_zu ) THEN 
    179167            !! Array 'stab' is free for the moment so using it to store 'zeta_t' 
    180             stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!! 
     168            stab = zt*ztmp0 
     169            stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!! 
    181170            stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again! 
    182171            t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b) 
    183172            q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c) 
    184             q_zu = max(0., q_zu) 
    185          END IF 
    186  
     173            q_zu = max(0._wp, q_zu) 
     174         ENDIF 
     175 
     176         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     177         !   In very rare low-wind conditions, the old way of estimating the 
     178         !   neutral wind speed at 10m leads to a negative value that causes the code 
     179         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    187180         ztmp2 = psi_m(zeta_u) 
    188181         IF( ln_cdgw ) THEN      ! surface wave case 
    189182            stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd)) 
    190183            Cd   = stab * stab 
    191             ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
     184            ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    192185            ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    193             ztmp1 = 1. + Chn * ztmp0      
     186            ztmp1 = 1._wp + Chn * ztmp0      
    194187            Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
    195             ztmp1 = 1. + Cen * ztmp0 
     188            ztmp1 = 1._wp + Cen * ztmp0 
    196189            Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    197190 
    198191         ELSE 
    199             ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
    200             !   In very rare low-wind conditions, the old way of estimating the 
    201             !   neutral wind speed at 10m leads to a negative value that causes the code 
    202             !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    203             ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
    204             ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
    205             Cdn(:,:) = ztmp0 
    206             sqrt_Cd_n10 = sqrt(ztmp0) 
    207  
    208             stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability 
    209             Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
    210             Chn(:,:) = Cx_n10 
    211  
    212             !! Update of transfer coefficients: 
    213             ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
    214             Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
    215             stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
    216  
    217             ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    218             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    219             ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
    220             Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
    221  
    222             Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
    223             Cen(:,:) = Cx_n10 
    224             ztmp1 = 1. + Cx_n10*ztmp0 
    225             Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    226             ENDIF 
    227          ! 
    228       END DO 
    229       ! 
     192         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     193         !   In very rare low-wind conditions, the old way of estimating the 
     194         !   neutral wind speed at 10m leads to a negative value that causes the code 
     195         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
     196         ztmp0 = MAX( 0.25_wp , U_blk/(1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
     197         ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
     198         Cdn(:,:) = ztmp0 
     199         sqrt_Cd_n10 = sqrt(ztmp0) 
     200 
     201         stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability 
     202         Cx_n10  = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
     203         Chn(:,:) = Cx_n10 
     204 
     205         !! Update of transfer coefficients: 
     206         ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
     207         Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
     208         stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
     209 
     210         ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
     211         ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
     212         ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
     213         Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
     214 
     215         Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
     216         Cen(:,:) = Cx_n10 
     217         ztmp1 = 1._wp + Cx_n10*ztmp0 
     218         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     219         ENDIF 
     220 
     221      END DO !DO j_itt = 1, nb_itt 
     222 
    230223   END SUBROUTINE turb_ncar 
    231224 
    … …  
    238231      !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
    239232      !! 
    240       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     233      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    241234      !!---------------------------------------------------------------------------------- 
    242235      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s) 
    … …  
    255248            ! 
    256249            ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
    257             zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1 
    258             ! 
    259             cd_neutral_10m(ji,jj) = 1.e-3 * ( & 
    260                &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s 
    261                &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s 
    262             ! 
    263             cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6) 
     250            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
     251            ! 
     252            cd_neutral_10m(ji,jj) = 1.e-3_wp * ( & 
     253               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
     254               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
     255            ! 
     256            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp) 
    264257            ! 
    265258         END DO 
    … …  
    273266      !! Universal profile stability function for momentum 
    274267      !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    275       !!      
    276       !! pzet0 : stability paramenter, z/L where z is altitude measurement                                           
     268      !! 
     269      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    277270      !!         and L is M-O length 
    278271      !! 
    279       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    280       !!---------------------------------------------------------------------------------- 
    281       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta 
    282       REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m 
    283       ! 
    284       INTEGER  ::   ji, jj         ! dummy loop indices 
     272      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     273      !!---------------------------------------------------------------------------------- 
     274      REAL(wp), DIMENSION(jpi,jpj) :: psi_m 
     275      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
     276      ! 
     277      INTEGER  ::   ji, jj    ! dummy loop indices 
    285278      REAL(wp) :: zx2, zx, zstab   ! local scalars 
    286279      !!---------------------------------------------------------------------------------- 
    287       ! 
    288280      DO jj = 1, jpj 
    289281         DO ji = 1, jpi 
    290             zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) ) 
    291             zx2 = MAX ( zx2 , 1. ) 
     282            zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
     283            zx2 = MAX( zx2 , 1._wp ) 
    292284            zx  = SQRT( zx2 ) 
    293             zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) ) 
    294             ! 
    295             psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable 
    296                &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable 
    297                &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    " 
     285            zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
     286            ! 
     287            psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable 
     288               &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable 
     289               &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    " 
    298290            ! 
    299291         END DO 
    300292      END DO 
    301       ! 
    302293   END FUNCTION psi_m 
    303294 
    … …  
    308299      !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    309300      !! 
    310       !! pzet0 : stability paramenter, z/L where z is altitude measurement                                           
     301      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    311302      !!         and L is M-O length 
    312303      !! 
    313       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    314       !!---------------------------------------------------------------------------------- 
     304      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     305      !!---------------------------------------------------------------------------------- 
     306      REAL(wp), DIMENSION(jpi,jpj) :: psi_h 
    315307      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    316       REAL(wp), DIMENSION(jpi,jpj)             :: psi_h 
    317       ! 
    318       INTEGER  ::   ji, jj    ! dummy loop indices 
     308      ! 
     309      INTEGER  ::   ji, jj     ! dummy loop indices 
    319310      REAL(wp) :: zx2, zstab  ! local scalars 
    320311      !!---------------------------------------------------------------------------------- 
    … …  
    322313      DO jj = 1, jpj 
    323314         DO ji = 1, jpi 
    324             zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) ) 
    325             zx2 = MAX ( zx2 , 1. ) 
    326             zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) ) 
    327             ! 
    328             psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable 
    329                &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable 
     315            zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
     316            zx2 = MAX( zx2 , 1._wp ) 
     317            zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
     318            ! 
     319            psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable 
     320               &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable 
    330321            ! 
    331322         END DO 
    332323      END DO 
    333       ! 
    334324   END FUNCTION psi_h 
    335325 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbccpl.F90

    r12109 r12154  
    533533      !                                                      ! ------------------------- ! 
    534534      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    535       lhftau = srcv(jpr_taum)%laction 
    536535      ! 
    537536      !                                                      ! ------------------------- ! 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcdcy.F90

    r10425 r12154  
    77   !!   NEMO    2.0  !  2006-02  (S. Masson, G. Madec)  adaptation to NEMO 
    88   !!           3.1  !  2009-07  (J.M. Molines)  adaptation to v3.1 
     9   !!           4.*  !  2019-10  (L. Brodeau)  nothing really new, but the routine 
     10   !!                ! "sbc_dcy_param" has been extracted from old function "sbc_dcy" 
     11   !!                ! => this allows the warm-layer param of COARE3* to know the time 
     12   !!                ! of dawn and dusk even if "ln_dm2dc=.false." (rdawn_dcy & rdusk_dcy 
     13   !!                ! are now public) 
    914   !!---------------------------------------------------------------------- 
    1015 
    … …  
    2227   IMPLICIT NONE 
    2328   PRIVATE 
    24     
     29 
    2530   INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed 
    26     
     31 
    2732   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters 
    28    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !    -      -       - 
    29    
     33   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       - 
     34   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       - 
     35 
    3036   PUBLIC   sbc_dcy        ! routine called by sbc 
     37   PUBLIC   sbc_dcy_param  ! routine used here and called by warm-layer parameterization (sbcblk_skin_coare*) 
    3138 
    3239   !!---------------------------------------------------------------------- 
    3340   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    34    !! $Id$  
     41   !! $Id$ 
    3542   !! Software governed by the CeCILL license (see ./LICENSE) 
    3643   !!---------------------------------------------------------------------- 
    3744CONTAINS 
    3845 
    39       INTEGER FUNCTION sbc_dcy_alloc() 
    40          !!---------------------------------------------------------------------- 
    41          !!                ***  FUNCTION sbc_dcy_alloc  *** 
    42          !!---------------------------------------------------------------------- 
    43          ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     & 
    44             &      rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) 
    45             ! 
    46          CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc ) 
    47          IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' ) 
    48       END FUNCTION sbc_dcy_alloc 
     46   INTEGER FUNCTION sbc_dcy_alloc() 
     47      !!---------------------------------------------------------------------- 
     48      !!                ***  FUNCTION sbc_dcy_alloc  *** 
     49      !!---------------------------------------------------------------------- 
     50      ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     & 
     51         &      rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) 
     52      ! 
     53      CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc ) 
     54      IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' ) 
     55   END FUNCTION sbc_dcy_alloc 
    4956 
    5057 
    … …  
    6067      !! 
    6168      !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007 
    62       !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.  
     69      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
    6370      !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590. 
    6471      !!---------------------------------------------------------------------- 
    6572      LOGICAL , OPTIONAL          , INTENT(in) ::   l_mask    ! use the routine for night mask computation 
    66       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux  
     73      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
    6774      REAL(wp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle 
    6875      !! 
    6976      INTEGER  ::   ji, jj                                       ! dummy loop indices 
    7077      INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask 
    71       REAL(wp) ::   ztwopi, zinvtwopi, zconvrad  
    7278      REAL(wp) ::   zlo, zup, zlousd, zupusd 
    73       REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos 
    74       REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest 
     79      REAL(wp) ::   ztmp, ztmp1, ztmp2 
    7580      REAL(wp) ::   ztmpm, ztmpm1, ztmpm2 
    76       !---------------------------statement functions------------------------ 
    77       REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments 
    78       fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         & 
    79          &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   & 
    80          & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1) 
    8181      !!--------------------------------------------------------------------- 
    8282      ! 
    8383      ! Initialization 
    8484      ! -------------- 
    85       ztwopi    = 2._wp * rpi 
    86       zinvtwopi = 1._wp / ztwopi 
    87       zconvrad  = ztwopi / 360._wp 
    88  
    8985      ! When are we during the day (from 0 to 1) 
    9086      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday 
    9187      zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday 
    92       !                                           
    93       IF( nday_qsr == -1 ) THEN       ! first time step only   
     88      ! 
     89      IF( nday_qsr == -1 ) THEN       ! first time step only 
    9490         IF(lwp) THEN 
    9591            WRITE(numout,*) 
    … …  
    9894            WRITE(numout,*) 
    9995         ENDIF 
     96      ENDIF 
     97 
     98      ! Setting parameters for each new day: 
     99      CALL sbc_dcy_param() 
     100 
     101      !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB 
     102      !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB 
     103      !CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB 
     104 
     105 
     106      !     3. update qsr with the diurnal cycle 
     107      !     ------------------------------------ 
     108 
     109      imask_night(:,:) = 0 
     110      DO jj = 1, jpj 
     111         DO ji = 1, jpi 
     112            ztmpm = 0._wp 
     113            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h 
     114               ! 
     115               IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part 
     116                  zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
     117                  zlousd = MIN(zlousd, zup) 
     118                  zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
     119                  zupusd = MAX(zupusd, zlo) 
     120                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     121                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     122                  ztmpm = zupusd - zlousd 
     123                  IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1 
     124                  ! 
     125               ELSE                                         ! day time in two parts 
     126                  zlousd = MIN(zlo, rdusk_dcy(ji,jj)) 
     127                  zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
     128                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     129                  ztmpm1=zupusd-zlousd 
     130                  zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
     131                  zupusd = MAX(zup, rdawn_dcy(ji,jj)) 
     132                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     133                  ztmpm2 =zupusd-zlousd 
     134                  ztmp = ztmp1 + ztmp2 
     135                  ztmpm = ztmpm1 + ztmpm2 
     136                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     137                  IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1 
     138               ENDIF 
     139            ELSE                                   ! 24h light or 24h night 
     140               ! 
     141               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day 
     142                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     143                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     144                  imask_night(ji,jj) = 0 
     145                  ! 
     146               ELSE                                         ! No day 
     147                  zqsrout(ji,jj) = 0.0_wp 
     148                  imask_night(ji,jj) = 1 
     149               ENDIF 
     150            ENDIF 
     151         END DO 
     152      END DO 
     153      ! 
     154      IF( PRESENT(l_mask) .AND. l_mask ) THEN 
     155         zqsrout(:,:) = float(imask_night(:,:)) 
     156      ENDIF 
     157      ! 
     158   END FUNCTION sbc_dcy 
     159 
     160 
     161   SUBROUTINE sbc_dcy_param( ) 
     162      !! 
     163      INTEGER  ::   ji, jj                                       ! dummy loop indices 
     164      !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask 
     165      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos 
     166      REAL(wp) ::   ztmp, ztest 
     167      !---------------------------statement functions------------------------ 
     168      ! 
     169      IF( nday_qsr == -1 ) THEN       ! first time step only 
    100170         ! allocate sbcdcy arrays 
    101171         IF( sbc_dcy_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc : unable to allocate arrays' ) 
    102172         ! Compute rcc needed to compute the time integral of the diurnal cycle 
    103          rcc(:,:) = zconvrad * glamt(:,:) - rpi 
     173         rcc(:,:) = rad * glamt(:,:) - rpi 
    104174         ! time of midday 
    105175         rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp 
    … …  
    107177      ENDIF 
    108178 
    109       ! If this is a new day, we have to update the dawn, dusk and scaling function   
     179      ! If this is a new day, we have to update the dawn, dusk and scaling function 
    110180      !---------------------- 
    111      
    112       !     2.1 dawn and dusk   
    113  
    114       ! nday is the number of days since the beginning of the current month  
    115       IF( nday_qsr /= nday ) THEN  
     181 
     182      !     2.1 dawn and dusk 
     183 
     184      ! nday is the number of days since the beginning of the current month 
     185      IF( nday_qsr /= nday ) THEN 
    116186         ! save the day of the year and the daily mean of qsr 
    117          nday_qsr = nday  
    118          ! number of days since the previous winter solstice (supposed to be always 21 December)          
     187         nday_qsr = nday 
     188         ! number of days since the previous winter solstice (supposed to be always 21 December) 
    119189         zdsws = REAL(11 + nday_year, wp) 
    120190         ! declination of the earths orbit 
    121          zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) ) 
     191         zdecrad = (-23.5_wp * rad) * COS( zdsws * 2._wp*rpi / REAL(nyear_len(1),wp) ) 
    122192         ! Compute A and B needed to compute the time integral of the diurnal cycle 
    123193 
    … …  
    125195         DO jj = 1, jpj 
    126196            DO ji = 1, jpi 
    127                ztmp = zconvrad * gphit(ji,jj) 
     197               ztmp = rad * gphit(ji,jj) 
    128198               raa(ji,jj) = SIN( ztmp ) * zsin 
    129199               rbb(ji,jj) = COS( ztmp ) * zcos 
    130             END DO   
    131          END DO   
     200            END DO 
     201         END DO 
    132202         ! Compute the time of dawn and dusk 
    133203 
    134          ! rab to test if the day time is equal to 0, less than 24h of full day         
     204         ! rab to test if the day time is equal to 0, less than 24h of full day 
    135205         rab(:,:) = -raa(:,:) / rbb(:,:) 
    136206         DO jj = 1, jpj 
    137207            DO ji = 1, jpi 
    138                IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
    139          ! When is it night? 
    140                   ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 
    141                   ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx ) 
    142          ! is it dawn or dusk? 
    143                   IF ( ztest > 0._wp ) THEN 
    144                      rdawn(ji,jj) = ztx 
    145                      rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) ) 
     208               IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
     209                  ! When is it night? 
     210                  ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 
     211                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + 2._wp*rpi * ztx ) 
     212                  ! is it dawn or dusk? 
     213                  IF( ztest > 0._wp ) THEN 
     214                     rdawn_dcy(ji,jj) = ztx 
     215                     rdusk_dcy(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn_dcy(ji,jj) ) 
    146216                  ELSE 
    147                      rdusk(ji,jj) = ztx 
    148                      rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) ) 
     217                     rdusk_dcy(ji,jj) = ztx 
     218                     rdawn_dcy(ji,jj) = rtmd(ji,jj) - ( rdusk_dcy(ji,jj) - rtmd(ji,jj) ) 
    149219                  ENDIF 
    150220               ELSE 
    151                   rdawn(ji,jj) = rtmd(ji,jj) + 0.5_wp 
    152                   rdusk(ji,jj) = rdawn(ji,jj) 
    153                ENDIF 
    154              END DO   
    155          END DO   
    156          rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp ) 
    157          rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp ) 
     221                  rdawn_dcy(ji,jj) = rtmd(ji,jj) + 0.5_wp 
     222                  rdusk_dcy(ji,jj) = rdawn_dcy(ji,jj) 
     223               ENDIF 
     224            END DO 
     225         END DO 
     226         rdawn_dcy(:,:) = MOD( (rdawn_dcy(:,:) + 1._wp), 1._wp ) 
     227         rdusk_dcy(:,:) = MOD( (rdusk_dcy(:,:) + 1._wp), 1._wp ) 
    158228         !     2.2 Compute the scaling function: 
    159229         !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk 
    … …  
    162232         DO jj = 1, jpj 
    163233            DO ji = 1, jpi 
    164                IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
     234               IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
    165235                  rscal(ji,jj) = 0.0_wp 
    166                   IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part 
    167                      IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN 
    168                        rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    169                        rscal(ji,jj) = 1._wp / rscal(ji,jj) 
     236                  IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN      ! day time in one part 
     237                     IF( (rdusk_dcy(ji,jj) - rdawn_dcy(ji,jj) ) .ge. 0.001_wp ) THEN 
     238                        rscal(ji,jj) = fintegral(rdawn_dcy(ji,jj), rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     239                        rscal(ji,jj) = 1._wp / rscal(ji,jj) 
    170240                     ENDIF 
    171241                  ELSE                                         ! day time in two parts 
    172                      IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN 
    173                        rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   & 
    174                           &         + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    175                        rscal(ji,jj) = 1. / rscal(ji,jj) 
     242                     IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN 
     243                        rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   & 
     244                           &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     245                        rscal(ji,jj) = 1. / rscal(ji,jj) 
    176246                     ENDIF 
    177247                  ENDIF 
    178248               ELSE 
    179                   IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day 
    180                      rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
     249                  IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day 
     250                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    181251                     rscal(ji,jj) = 1._wp / rscal(ji,jj) 
    182252                  ELSE                                          ! No day 
    … …  
    184254                  ENDIF 
    185255               ENDIF 
    186             END DO   
    187          END DO   
     256            END DO 
     257         END DO 
    188258         ! 
    189259         ztmp = rday / ( rdt * REAL(nn_fsbc, wp) ) 
    190260         rscal(:,:) = rscal(:,:) * ztmp 
    191261         ! 
    192       ENDIF  
    193          !     3. update qsr with the diurnal cycle 
    194          !     ------------------------------------ 
    195  
    196       imask_night(:,:) = 0 
    197       DO jj = 1, jpj 
    198          DO ji = 1, jpi 
    199             ztmpm = 0._wp 
    200             IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h 
    201                ! 
    202                IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part 
    203                   zlousd = MAX(zlo, rdawn(ji,jj)) 
    204                   zlousd = MIN(zlousd, zup) 
    205                   zupusd = MIN(zup, rdusk(ji,jj)) 
    206                   zupusd = MAX(zupusd, zlo) 
    207                   ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    208                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
    209                   ztmpm = zupusd - zlousd 
    210                   IF ( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1 
    211                   ! 
    212                ELSE                                         ! day time in two parts 
    213                   zlousd = MIN(zlo, rdusk(ji,jj)) 
    214                   zupusd = MIN(zup, rdusk(ji,jj)) 
    215                   ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    216                   ztmpm1=zupusd-zlousd 
    217                   zlousd = MAX(zlo, rdawn(ji,jj)) 
    218                   zupusd = MAX(zup, rdawn(ji,jj)) 
    219                   ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    220                   ztmpm2 =zupusd-zlousd 
    221                   ztmp = ztmp1 + ztmp2 
    222                   ztmpm = ztmpm1 + ztmpm2 
    223                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
    224                   IF (ztmpm .EQ. 0.) imask_night(ji,jj) = 1 
    225                ENDIF 
    226             ELSE                                   ! 24h light or 24h night 
    227                ! 
    228                IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day 
    229                   ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    230                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
    231                   imask_night(ji,jj) = 0 
    232                   ! 
    233                ELSE                                         ! No day 
    234                   zqsrout(ji,jj) = 0.0_wp 
    235                   imask_night(ji,jj) = 1 
    236                ENDIF 
    237             ENDIF 
    238          END DO   
    239       END DO   
    240       ! 
    241       IF( PRESENT(l_mask) .AND. l_mask ) THEN 
    242          zqsrout(:,:) = float(imask_night(:,:)) 
    243       ENDIF 
    244       ! 
    245    END FUNCTION sbc_dcy 
     262      ENDIF !IF( nday_qsr /= nday ) 
     263      ! 
     264   END SUBROUTINE sbc_dcy_param 
     265 
     266 
     267   FUNCTION fintegral( pt1, pt2, paaa, pbbb, pccc ) 
     268      REAL(wp), INTENT(in) :: pt1, pt2, paaa, pbbb, pccc 
     269      REAL(wp) :: fintegral 
     270      fintegral =   paaa * pt2 + 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt2)   & 
     271         &        - paaa * pt1 - 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt1) 
     272   END FUNCTION fintegral 
    246273 
    247274   !!====================================================================== 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcice_cice.F90

    r11536 r12154  
    132132         IF      ( ksbc == jp_flx ) THEN 
    133133            CALL cice_sbc_force(kt) 
    134          ELSE IF ( ksbc == jp_purecpl ) THEN 
     134         ELSE IF( ksbc == jp_purecpl ) THEN 
    135135            CALL sbc_cpl_ice_flx( fr_i ) 
    136136         ENDIF 
    … …  
    140140         CALL cice_sbc_out ( kt, ksbc ) 
    141141 
    142          IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
     142         IF( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
    143143 
    144144      ENDIF                                          ! End sea-ice time step only 
    … …  
    168168      ! there is no restart file. 
    169169      ! Values from a CICE restart file would overwrite this 
    170       IF ( .NOT. ln_rstart ) THEN     
     170      IF( .NOT. ln_rstart ) THEN     
    171171         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
    172172      ENDIF   
    … …  
    177177 
    178178! Do some CICE consistency checks 
    179       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    180          IF ( calc_strair .OR. calc_Tsfc ) THEN 
     179      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
     180         IF( calc_strair .OR. calc_Tsfc ) THEN 
    181181            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    182182         ENDIF 
    183       ELSEIF (ksbc == jp_blk) THEN 
    184          IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
     183      ELSEIF(ksbc == jp_blk) THEN 
     184         IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
    185185            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 
    186186         ENDIF 
    … …  
    202202 
    203203      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    204       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
     204      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    205205         DO jl=1,ncat 
    206206            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    297297! forced and coupled case  
    298298 
    299       IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
     299      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    300300 
    301301         ztmpn(:,:,:)=0.0 
    … …  
    322322 
    323323! Surface downward latent heat flux (CI_5) 
    324          IF (ksbc == jp_flx) THEN 
     324         IF(ksbc == jp_flx) THEN 
    325325            DO jl=1,ncat 
    326326               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    … …  
    332332            DO jj=1,jpj 
    333333               DO ji=1,jpi 
    334                   IF (fr_i(ji,jj).eq.0.0) THEN 
     334                  IF(fr_i(ji,jj).eq.0.0) THEN 
    335335                     DO jl=1,ncat 
    336336                        ztmpn(ji,jj,jl)=0.0 
    … …  
    351351! GBM conductive flux through ice (CI_6) 
    352352!  Convert to GBM 
    353             IF (ksbc == jp_flx) THEN 
     353            IF(ksbc == jp_flx) THEN 
    354354               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    355355            ELSE 
    … …  
    360360! GBM surface heat flux (CI_7) 
    361361!  Convert to GBM 
    362             IF (ksbc == jp_flx) THEN 
     362            IF(ksbc == jp_flx) THEN 
    363363               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    364364            ELSE 
    … …  
    368368         ENDDO 
    369369 
    370       ELSE IF (ksbc == jp_blk) THEN 
     370      ELSE IF(ksbc == jp_blk) THEN 
    371371 
    372372! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself) 
    … …  
    546546! Freshwater fluxes  
    547547 
    548       IF (ksbc == jp_flx) THEN 
     548      IF(ksbc == jp_flx) THEN 
    549549! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 
    550550! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below 
    … …  
    552552! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    553553         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    554       ELSE IF (ksbc == jp_blk) THEN 
     554      ELSE IF(ksbc == jp_blk) THEN 
    555555         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    556       ELSE IF (ksbc == jp_purecpl) THEN 
     556      ELSE IF(ksbc == jp_purecpl) THEN 
    557557! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    558558! This is currently as required with the coupling fields from the UM atmosphere 
    … …  
    584584! Scale qsr and qns according to ice fraction (bulk formulae only) 
    585585 
    586       IF (ksbc == jp_blk) THEN 
     586      IF(ksbc == jp_blk) THEN 
    587587         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 
    588588         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 
    589589      ENDIF 
    590590! Take into account snow melting except for fully coupled when already in qns_tot 
    591       IF (ksbc == jp_purecpl) THEN 
     591      IF(ksbc == jp_purecpl) THEN 
    592592         qsr(:,:)= qsr_tot(:,:) 
    593593         qns(:,:)= qns_tot(:,:) 
    … …  
    624624 
    625625      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    626       IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
     626      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    627627         DO jl=1,ncat 
    628628            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    879879!     B. Gather pn into global array (png) 
    880880 
    881       IF ( jpnij > 1) THEN 
     881      IF( jpnij > 1) THEN 
    882882         CALL mppsync 
    883883         CALL mppgather (pn,0,png)  
    … …  
    892892! (may be OK but not 100% sure) 
    893893 
    894       IF (nproc==0) THEN      
     894      IF(nproc==0) THEN      
    895895!        pcg(:,:)=0.0 
    896896         DO jn=1,jpnij 
    … …  
    10151015! the lbclnk call on pn will replace these with sensible values 
    10161016 
    1017       IF (nproc==0) THEN 
     1017      IF(nproc==0) THEN 
    10181018         png(:,:,:)=0.0 
    10191019         DO jn=1,jpnij 
    … …  
    10281028!     C. Scatter png into NEMO field (pn) for each processor 
    10291029 
    1030       IF ( jpnij > 1) THEN 
     1030      IF( jpnij > 1) THEN 
    10311031         CALL mppsync 
    10321032         CALL mppscatter (png,0,pn)  

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcisf.F90

    r11536 r12154  
    303303      ! 
    304304      ! Allocate public variable 
    305       IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' ) 
     305      IF( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' ) 
    306306      ! 
    307307      ! initialisation 
    … …  
    440440            !! Initialize arrays to 0 (each step) 
    441441            zt_sum = 0.e0_wp 
    442             IF ( ik > 1 ) THEN 
     442            IF( ik > 1 ) THEN 
    443443               ! 1. -----------the average temperature between 200m and 600m --------------------- 
    444444               DO jk = misfkt(ji,jj),misfkb(ji,jj) 
    … …  
    459459            ELSE 
    460460               qisf(ji,jj) = 0._wp   ;   fwfisf(ji,jj) = 0._wp 
    461             END IF 
     461            ENDIF 
    462462         END DO 
    463463      END DO 
    … …  
    496496      ! coeficient for linearisation of potential tfreez 
    497497      ! Crude approximation for pressure (but commonly used) 
    498       IF ( l_useCT ) THEN   ! linearisation from Jourdain et al. (2017) 
     498      IF( l_useCT ) THEN   ! linearisation from Jourdain et al. (2017) 
    499499         zlamb1 =-0.0564_wp 
    500500         zlamb2 = 0.0773_wp 
    … …  
    558558                  ! compute s freeze 
    559559                  zsfrz=(-zbqe-SQRT(zdis))*zaqer 
    560                   IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer 
     560                  IF( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer 
    561561 
    562562                  ! compute t freeze (eq. 22) 
    … …  
    578578 
    579579         ! define if we need to iterate (nn_gammablk 0/1 do not need iteration) 
    580          IF ( nn_gammablk <  2 ) THEN ; lit = .FALSE. 
     580         IF( nn_gammablk <  2 ) THEN ; lit = .FALSE. 
    581581         ELSE                            
    582582            ! check total number of iteration 
    583             IF (nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
     583            IF(nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
    584584            ELSE                 ; nit = nit + 1 
    585             END IF 
     585            ENDIF 
    586586 
    587587            ! compute error between 2 iterations 
    588588            ! if needed save gammat and compute zhtflx_b for next iteration 
    589589            zerr = MAXVAL(ABS(zhtflx-zhtflx_b)) 
    590             IF ( zerr <= 0.01_wp ) THEN ; lit = .FALSE. 
     590            IF( zerr <= 0.01_wp ) THEN ; lit = .FALSE. 
    591591            ELSE                        ; zhtflx_b(:,:) = zhtflx(:,:) 
    592             END IF 
    593          END IF 
     592            ENDIF 
     593         ENDIF 
    594594      END DO 
    595595      ! 
    … …  
    718718                  pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 
    719719                  pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 
    720                END IF 
     720               ENDIF 
    721721            END DO 
    722722         END DO 
    … …  
    757757               ! determine the deepest level influenced by the boundary layer 
    758758               DO jk = ikt+1, mbku(ji,jj) 
    759                   IF ( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 
     759                  IF( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 
    760760               END DO 
    761761               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    … …  
    789789               ! determine the deepest level influenced by the boundary layer 
    790790               DO jk = ikt+1, mbkv(ji,jj) 
    791                   IF ( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 
     791                  IF( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 
    792792               END DO 
    793793               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    … …  
    869869               ! determine the deepest level influenced by the boundary layer 
    870870               DO jk = ikt, mbkt(ji,jj) 
    871                   IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     871                  IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    872872               END DO 
    873873               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    … …  
    879879            END DO 
    880880         END DO 
    881       END IF  
     881      ENDIF  
    882882      ! 
    883883      !==   ice shelf melting distributed over several levels   ==! 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcmod.F90

    r12109 r12154  
    1515   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting 
    1616   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation 
     17   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
    1718   !!---------------------------------------------------------------------- 
    1819 
    … …  
    3233   USE sbcflx         ! surface boundary condition: flux formulation 
    3334   USE sbcblk         ! surface boundary condition: bulk formulation 
     35   USE sbcabl         ! atmospheric boundary layer 
    3436   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model 
    3537#if defined key_si3 
    … …  
    9294      !! 
    9395      NAMELIST/namsbc/ nn_fsbc  ,                                                    & 
    94          &             ln_usr   , ln_flx   , ln_blk       ,                          & 
     96         &             ln_usr   , ln_flx   , ln_blk   , ln_abl,                      & 
    9597         &             ln_cpl   , ln_mixcpl, nn_components,                          & 
    9698         &             nn_ice   , ln_ice_embd,                                       & 
    9799         &             ln_traqsr, ln_dm2dc ,                                         & 
    98100         &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     & 
    99          &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor   ,     & 
     101         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor  ,     & 
    100102         &             ln_tauw  , nn_lsm, nn_sdrift 
    101103      !!---------------------------------------------------------------------- 
    … …  
    125127         IF( lk_cice )   nn_ice      = 3 
    126128      ENDIF 
    127 #else 
    128       IF( lk_si3  )   nn_ice      = 2 
    129       IF( lk_cice )   nn_ice      = 3 
     129!!GS: TBD 
     130!#else 
     131!      IF( lk_si3  )   nn_ice      = 2 
     132!      IF( lk_cice )   nn_ice      = 3 
    130133#endif 
    131134      ! 
    … …  
    137140         WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx 
    138141         WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk 
     142         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl 
    139143         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : ' 
    140144         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    … …  
    225229      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)   
    226230      CASE( 2 )                        !- SI3  ice model 
     231         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   & 
     232            &                   CALL ctl_stop( 'sbc_init : SI3 sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 
    227233      CASE( 3 )                        !- CICE ice model 
    228          IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' ) 
    229          IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' )  
     234         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   & 
     235            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 
     236         IF( lk_agrif                                )   & 
     237            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' )  
    230238      CASE DEFAULT                     !- not supported 
    231239      END SELECT 
    … …  
    243251         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp 
    244252         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp 
    245       END IF 
     253      ENDIF 
    246254      ! 
    247255      IF( sbc_ssr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) 
    … …  
    262270 
    263271      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
     272      nday_qsr = -1   ! allow initialization at the 1st call !LB: now warm-layer of COARE* calls "sbc_dcy_param" of sbcdcy.F90! 
    264273      IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle 
    265          nday_qsr = -1   ! allow initialization at the 1st call 
    266          IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   & 
    267             &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' ) 
     274         !LB:nday_qsr = -1   ! allow initialization at the 1st call 
     275         IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa )   & 
     276            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' ) 
    268277      ENDIF 
    269278      !                             !* Choice of the Surface Boudary Condition 
    … …  
    278287      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
    279288      IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation 
     289      IF( ln_abl          ) THEN   ;   nsbc = jp_abl     ; icpt = icpt + 1   ;   ENDIF       ! ABL                  formulation 
    280290      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
    281291      IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
    … …  
    289299         CASE( jp_flx     )   ;   WRITE(numout,*) '   ==>>>   flux formulation' 
    290300         CASE( jp_blk     )   ;   WRITE(numout,*) '   ==>>>   bulk formulation' 
     301         CASE( jp_abl     )   ;   WRITE(numout,*) '   ==>>>   ABL  formulation' 
    291302         CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation' 
    292303!!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter 
    … …  
    339350      IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization 
    340351 
     352      IF( ln_abl      )   CALL sbc_abl_init            ! Atmospheric Boundary Layer (ABL) 
     353 
    341354      IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization 
    342355      ! 
    … …  
    406419         emp_b (:,:) = emp (:,:) 
    407420         sfx_b (:,:) = sfx (:,:) 
    408          IF ( ln_rnf ) THEN 
     421         IF( ln_rnf ) THEN 
    409422            rnf_b    (:,:  ) = rnf    (:,:  ) 
    410423            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    … …  
    437450                               CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean 
    438451                               ! 
     452      CASE( jp_abl     ) 
     453         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA 
     454                               CALL sbc_abl       ( kt )                    ! ABL  formulation for the ocean 
     455                               ! 
    439456      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
    440457      CASE( jp_none    ) 
    … …  
    444461      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
    445462      ! 
    446       IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )      ! Wind stress provided by waves  
     463      IF( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )      ! Wind stress provided by waves  
    447464      ! 
    448465      !                                            !==  Misc. Options  ==! 
    … …  
    478495!!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
    479496!!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) 
    480       IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now 
     497      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    481498         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999  
    482499         zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
    … …  
    510527            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios )   ! before i-stress  (U-point) 
    511528            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios )   ! before j-stress  (V-point) 
    512             CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point) 
     529            CALL iom_get( numror, jpdom_autoglo,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point) 
    513530            ! The 3D heat content due to qsr forcing is treated in traqsr 
    514531            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbcrnf.F90

    r12109 r12154  
    468468         !                                      !    - mixed upstream-centered (ln_traadv_cen2=T) 
    469469         ! 
    470          IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   & 
     470         IF( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   & 
    471471            &                                              'be spread through depth by ln_rnf_depth'               ) 
    472472         ! 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbctide.F90

    r10068 r12154  
    7272         ! Temporarily set nsec_day to beginning of day. 
    7373         nsec_day_orig = nsec_day 
    74          IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN  
     74         IF( nsec_day /= NINT(0.5_wp * rdt) ) THEN  
    7575            kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
    7676            nsec_day = NINT(0.5_wp * rdt) 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/tideini.F90

    r11536 r12154  
    6868      ! 
    6969      IF( ln_tide ) THEN 
    70          IF (lwp) THEN 
     70         IF(lwp) THEN 
    7171            WRITE(numout,*) 
    7272            WRITE(numout,*) 'tide_init : Initialization of the tidal components' 
    … …  
    127127      kt_tide = nit000 
    128128      ! 
    129       IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp 
     129      IF(.NOT.ln_scal_load ) rn_scal_load = 0._wp 
    130130      ! 
    131131   END SUBROUTINE tide_init 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/TRA/traadv_fct.F90

    r12109 r12154  
    104104      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE.  
    105105      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  & 
    106          &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     106          &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    107107      ! 
    108108      IF( l_trd .OR. l_hst )  THEN 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/ZDF/zdfiwm.F90

    r11536 r12154  
    414414      !!              de Lavergne et al. in prep., 2017 
    415415      !!---------------------------------------------------------------------- 
    416       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    417416      INTEGER  ::   inum         ! local integer 
    418417      INTEGER  ::   ios 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/SAS/diawri.F90

    r11536 r12154  
    2424   !!---------------------------------------------------------------------- 
    2525   USE oce             ! ocean dynamics and tracers  
     26   USE abl            ! abl variables in case ln_abl = .true. 
    2627   USE dom_oce         ! ocean space and time domain 
    2728   USE zdf_oce         ! ocean vertical physics 
    … …  
    5152   PUBLIC   dia_wri_state 
    5253   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    53  
     54#if ! defined key_iomput    
     55   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.) 
     56#endif 
    5457   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    5558   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file 
    5659   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
     60   INTEGER ::   ndim_A, ndim_hA                      ! ABL file    
     61   INTEGER ::   nid_A, nz_A, nh_A                    ! grid_ABL file    
    5762   INTEGER ::   ndex(1)                              ! ??? 
    5863   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
     64   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
    5965 
    6066   !! * Substitutions 
    … …  
    114120   END FUNCTION dia_wri_alloc 
    115121    
     122   INTEGER FUNCTION dia_wri_alloc_abl() 
     123      !!---------------------------------------------------------------------- 
     124     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 
     125      CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 
     126      ! 
     127   END FUNCTION dia_wri_alloc_abl 
    116128   
    117129   SUBROUTINE dia_wri( kt ) 
    … …  
    136148      INTEGER  ::   ierr                                     ! error code return from allocation 
    137149      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     150      INTEGER  ::   ipka                                     ! ABL 
    138151      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
     152      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    139153      !!---------------------------------------------------------------------- 
    140154      ! 
    … …  
    174188      ijmi = 1      ;      ijma = jpj 
    175189      ipk = jpk 
     190     IF(ln_abl) ipka = jpkam1 
    176191 
    177192      ! define time axis 
    … …  
    241256 
    242257         ! No W grid FILE 
     258         IF( ln_abl ) THEN  
     259         ! Define the ABL grid FILE ( nid_A ) 
     260            CALL dia_nam( clhstnam, nwrite, 'grid_ABL' ) 
     261            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
     262            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     263               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
     264               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 
     265            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept 
     266               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 
     267            !                                                            ! Index of ocean points 
     268         ALLOCATE( zw3d_abl(jpi,jpj,ipka) )  
     269         zw3d_abl(:,:,:) = 1._wp  
     270         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume 
     271            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface 
     272         DEALLOCATE(zw3d_abl) 
     273         ENDIF 
    243274 
    244275         ! Declare all the output fields as NETCDF variables 
    … …  
    261292         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    262293            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     294! 
     295         IF( ln_abl ) THEN 
     296         !                                                                                      !!! nid_A : 3D 
     297         CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl 
     298               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     299            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl 
     300               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     301            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl 
     302               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     303            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl 
     304               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     305            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl 
     306               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     307            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl 
     308               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     309            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl 
     310               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     311            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh 
     312               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                  
     313#if defined key_si3 
     314            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i 
     315               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout ) 
     316#endif 
     317          CALL histend( nid_A, snc4chunks=snc4set ) 
     318       ! 
     319       ENDIF 
     320! 
    263321 
    264322         CALL histend( nid_T, snc4chunks=snc4set ) 
    … …  
    310368      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    311369      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
     370! 
     371      IF( ln_abl ) THEN  
     372        ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 
     373        IF( ln_mskland )   THEN  
     374          DO jk=1,jpka 
     375             zw3d_abl(:,:,jk) = tmask(:,:,1) 
     376            END DO 
     377       ELSE 
     378            zw3d_abl(:,:,:) = 1._wp      
     379         ENDIF        
     380       CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh  
     381        CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl 
     382        CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl 
     383        CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl 
     384        CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl      
     385        CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl 
     386        CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl 
     387        CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl   
     388#if defined key_si3 
     389         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i 
     390#endif 
     391       DEALLOCATE(zw3d_abl) 
     392     ENDIF 
     393! 
    312394 
    313395         ! Write fields on U grid 
    … …  
    325407         CALL histclo( nid_U ) 
    326408         CALL histclo( nid_V ) 
     409         IF(ln_abl) CALL histclo( nid_A ) 
    327410      ENDIF 
    328411      ! 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/tests/demo_cfgs.txt

    r10516 r12154  
    99WAD OCE 
    1010BENCH OCE ICE TOP 
     11STATION_ASF OCE 

  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/tests/test_cases.bib

    r10627 r12154  
    115115   abstract = {Many problems of fluid dynamics involve the coupled transport of several, density-like, dependent variables (for instance, densities of mass and momenta in elastic flows). In this paper, a conservative and synchronous flux-corrected transport (FCT) formalism is developed which aims at a consistent transport of such variables. The technique differs from traditional FCT algorithms in two respects. First, the limiting of transportive fluxes of the primary variables (e.g., mass and momentum) does not derive from smooth estimates of the variables, but it derives from analytic constraints implied by the Lagrangian form of the governing continuity equations, which are imposed on the specific mixing ratios of the variables (e.g., velocity components). Second, the traditional FCT limiting based on sufficiency conditions is augmented by an iterative procedure which approaches the necessity requirements. This procedure can also be used in the framework of traditional FCT schemes, and a demonstration is provided that it can significantly reduce some of the pathological behaviors of FCT algorithms. Although the approach derived is applicable to the transport of arbitrary conserved quantities, it is particularly useful for the synchronous transport of mass and momenta in elastic flows, where it assures intrinsic stability of the algorithm regardless of the magnitude of the mass-density variable. This latter property becomes especially important in fluids with large density variations, or in models with a material “vertical” coordinate (e.g., geophysical hydrostatic stratified flows in isopycnic/isentropic coordinates), where material surfaces can collapse to zero-mass layers admitting, therefore, arbitrarily large local Courant numbers.} 
    116116} 
     117 
     118@article{Brodeau_al_2017, 
     119author={Laurent Brodeau and Bernard Barnier and Sergey Gulev and Cian Woods}, 
     120title={Climatologically significant effects of some approximations in the bulk parameterizations of turbulent air-sea fluxes}, 
     121journal={J. Phys. Oceanogr.}, 
     122doi={10.1175/JPO-D-16-0169.1}, 
     123year={2017}, 
     124pages = {5-28}, 
     125volume={47}, 
     126number={1} 
     127} 
Note: See TracChangeset for help on using the changeset viewer.