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

Changeset 13159


Ignore:
Timestamp:
2020-06-26T10:26:32+02:00 (4 years ago)
Author:
gsamson
Message:

merge trunk@r13136 into ASINTER-06 branch; pass all SETTE tests; results identical to trunk@r13136; ticket #2419

Location:
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement
Files:
105 edited
1 copied

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement

    • Property svn:externals
      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@12931        sette 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r12489 r13159  
    8181   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    8282                     ! Sea-ice : 
    83    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    84                            !          except in AGRIF zoom where it has to be specified 
     83   nn_ice      = 2         !  =0 no ice boundary condition 
     84      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     85      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8586                     ! Misc. options of sbc :  
    8687   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

    r12489 r13159  
    7878   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    7979                     ! Sea-ice : 
    80    nn_ice      = 2         !  =0   Use SI3 model 
     80   nn_ice      = 2         !  =0 no ice boundary condition 
     81      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     82      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8183                     ! Misc. options of sbc :  
    8284   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

    r12489 r13159  
    7878   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    7979                     ! Sea-ice : 
    80    nn_ice      = 2         !  =0   Use SI3 model 
     80   nn_ice      = 2         !  =0 no ice boundary condition 
     81      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     82      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8183                     ! Misc. options of sbc :  
    8284   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r12489 r13159  
    8181   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    8282                     ! Sea-ice : 
    83    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    84                            !          except in AGRIF zoom where it has to be specified 
     83   nn_ice      = 2         !  =0 no ice boundary condition 
     84      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     85      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8586                     ! Misc. options of sbc :  
    8687   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/C1D_PAPA/EXPREF/file_def_nemo-oce.xml

    r9799 r13159  
    5353        <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" > 
    5454          <field field_ref="e3w" /> 
    55           <field field_ref="woce"         name="wo"       /> 
    5655          <field field_ref="avt"          name="difvho"   /> 
    5756        </file> 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/C1D_PAPA/EXPREF/namelist_cfg

    r12489 r13159  
    4949&namdom        !   time and space domain 
    5050!----------------------------------------------------------------------- 
     51   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     52   ! 
    5153   rn_Dt      =  360.     !  time step for the dynamics and tracer 
    5254/ 
     
    358360&namdyn_spg    !   surface pressure gradient                            (default: NO selection) 
    359361!----------------------------------------------------------------------- 
    360    ln_dynspg_ts   = .true.   ! split-explicit free surface 
    361       ln_bt_fw      = .false.     ! Forward integration of barotropic Eqs. 
    362       ln_bt_av      = .true.     ! Time filtering of barotropic variables 
    363362/ 
    364363!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg

    r12749 r13159  
    2222   cn_exp      =  "ORCA2"  !  experience name 
    2323   nn_it000    =       1   !  first time step 
    24    nn_itend    =    5840   !  last  time step (std 5840) 
     24   nn_itend    =      16   !  last  time step (std 5475) 
    2525   nn_date0    =  20130101 !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    2626   nn_write    =       4   !  frequency of write in the output file   (modulo referenced to nn_it000) 
     
    3131&namdom        !   time and space domain 
    3232!----------------------------------------------------------------------- 
    33    rn_Dt       = 5400.     !  time step for the dynamics and tracer 
     33   rn_Dt      = 5400.     !  time step for the dynamics and tracer 
    3434/ 
    3535!----------------------------------------------------------------------- 
     
    5656   sn_sal = 'data_1m_salinity_nomask'             ,     -1.     ,'vosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
    5757/ 
    58  
    5958!!====================================================================== 
    6059!!            ***  Surface Boundary Condition namelists  ***          !! 
     
    7069!!   namsbc_rnf      river runoffs                                      (ln_rnf     =T) 
    7170!!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T) 
     71!!   namsbc_isf      ice shelf melting/freezing                         (ln_isfcav  =T : read (ln_read_cfg=T) or set or usr_def_zgr ) 
     72!!   namsbc_iscpl    coupling option between land ice model and ocean   (ln_isfcav  =T) 
    7273!!   namsbc_wave     external fields from wave model                    (ln_wave    =T) 
    7374!!   namberg         iceberg floats                                     (ln_icebergs=T) 
     
    7879!----------------------------------------------------------------------- 
    7980   nn_fsbc     = 1         !  frequency of SBC module call 
    80       !                    !  (control sea-ice & iceberg model call) 
    81                      ! Type of air-sea fluxes 
     81                           !     (also = the frequency of sea-ice & iceberg model call) 
     82                     ! Type of air-sea fluxes  
    8283   ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk ) 
    8384   ln_abl      = .true.    !  ABL  formulation                          (T => fill namsbc_abl ) 
     
    8687      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
    8788      !                    !  =2 or 3 for SI3 and CICE, respectively 
    88    ln_ice_embd = .false.   !  =T embedded sea-ice (pressure + mass and salt exchanges) 
    89       !                    !  =F levitating ice (no pressure, mass and salt exchanges) 
    90                      ! Misc. options of sbc : 
     89                     ! Misc. options of sbc :  
    9190   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
     91   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    9292   ln_dm2dc    = .true.    !  daily mean to diurnal cycle on short wave 
    93    ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    94    nn_fwb      = 2         !  FreshWater Budget: =0 unchecked 
    95       !                    !     =1 global mean of e-p-r set to zero at each time step 
    96       !                    !     =2 annual global mean of e-p-r set to zero 
    9793   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
     94   nn_fwb      = 2         !  FreshWater Budget:  
     95   !                       !    =2 annual global mean of e-p-r set to zero 
    9896   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave) 
    9997   ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 
    100    ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 
     98   ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)  
    10199   nn_sdrift   =  0        !  Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 
    102100      !                    !   = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
     
    114112   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    115113   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    116    ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 45r1) 
     114   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     115      rn_zqt      = 10.     !  Air temperature & humidity reference height (m) 
     116      rn_zu       = 10.     !  Wind vector reference height (m) 
    117117      ! 
    118       ln_humi_sph = .true.  !  humidity "sn_humi" is specific humidity  [kg/kg] 
    119       ln_tpot     = .false. !!GS: compute potential temperature or not 
     118      ! Skin is ONLY available in ECMWF and COARE algorithms: 
     119      ln_skin_cs = .false.  !  use the cool-skin parameterization => set nn_fsbc=1 and ln_dm2dc=.true.! 
     120      ln_skin_wl = .false.  !  use the warm-layer        "        => set nn_fsbc=1 and ln_dm2dc=.true.! 
     121      ! 
     122      ln_humi_sph = .true.  !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
     123      ln_humi_dpt = .false. !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
     124      ln_humi_rlh = .false. !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    120125   ! 
    121    cn_dir      = './'      !  root directory for the bulk data location 
     126   cn_dir = './'  !  root directory for the bulk data location 
    122127   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    123128   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !          weights filename            ! rotation ! land/sea mask ! 
     
    142147   cn_dir         = './'      !  root directory for the location of the ABL grid file 
    143148   cn_dom         = 'dom_cfg_abl_L25Z10.nc' 
    144  
    145    ln_rstart_abl  = .false. 
    146149   ln_hpgls_frc   = .true. 
    147150   ln_geos_winds  = .false. 
    148151   nn_dyn_restore = 1 
    149  
    150    rn_ldyn_min   =  4.5       !  magnitude of the nudging on ABL dynamics at the bottom of the ABL   [hour] 
     152   rn_ldyn_min   =  7.5       !  magnitude of the nudging on ABL dynamics at the bottom of the ABL   [hour] 
    151153   rn_ldyn_max   =  1.5       !  magnitude of the nudging on ABL dynamics at the top of the ABL   [hour] 
    152    rn_ltra_min   =  4.5       !  magnitude of the nudging on ABL tracers  at the bottom of the ABL   [hour] 
     154   rn_ltra_min   =  7.5       !  magnitude of the nudging on ABL tracers  at the bottom of the ABL   [hour] 
    153155   rn_ltra_max   =  1.5       !  magnitude of the nudging on ABL tracers  at the top of the ABL   [hour] 
    154156/ 
     
    200202&namberg       !   iceberg parameters                                   (default: OFF) 
    201203!----------------------------------------------------------------------- 
    202    ln_icebergs = .true.    ! activate iceberg floats (force =F with "key_agrif") 
    203  
    204    cn_dir = './'  !  root directory for the location of drag coefficient files 
    205    !______!___________!___________________!______________!______________!_________!___________!__________!__________!_______________! 
    206    !      ! file name ! frequency (hours) !   variable   ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    207    !      !           !  (if <0  months)  !     name     !   (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
    208    sn_icb =  'calving',       -1.         , 'calving'    ,   .true.     , .true.  , 'yearly'  , ''       , ''       , '' 
    209204/ 
    210205!!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r12501 r13159  
    8080   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    8181                     ! Sea-ice : 
    82    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    83                            !          except in AGRIF zoom where it has to be specified 
     82   nn_ice      = 2         !  =0 no ice boundary condition 
     83      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     84      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8485                     ! Misc. options of sbc :  
    8586   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
     
    120121/ 
    121122!----------------------------------------------------------------------- 
     123&namsbc_abl    !   Atmospheric Boundary Layer formulation           (ln_abl = T) 
     124!----------------------------------------------------------------------- 
     125/ 
     126!----------------------------------------------------------------------- 
    122127&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr =T) 
    123128!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_top_cfg

    r12377 r13159  
    2020! 
    2121   ln_trcdta     =  .true.  !  Initialisation from data input file (T) or not (F) 
    22    ln_trcbc      =  .true.  !  Enables Boundary conditions 
     22   ln_trcbc      =  .false. !  Enables Boundary conditions 
    2323!                !           !                                           !             !         ! 
    2424!                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc  !  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_top_cfg

    r12377 r13159  
    2020! 
    2121   ln_trcdta     =  .true.   !  Initialisation from data input file (T) or not (F) 
    22    ln_trcbc      =  .true.   !  Enables Boundary conditions 
     22   ln_trcbc      =  .false.  !  Enables Boundary conditions 
    2323!                !           !                                           !             !         ! 
    2424!                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc  !  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

    r12377 r13159  
    5959   nn_fsbc     = 1         !  frequency of SBC module call 
    6060   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    61    nn_ice      = 2         !  =2  sea-ice model                         ("key_SI3" or "key_cice") 
     61   nn_ice      = 2         !  =0 no ice boundary condition 
     62      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     63      !                    !  =2 or 3 for SI3 and CICE, respectively 
    6264/ 
    6365!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/SHARED/field_def_nemo-oce.xml

    r12749 r13159  
    1 <?xml version="1.0"?>  
     1<?xml version="1.0"?> 
    22    <!-- $id$ --> 
    33 
     
    1616                         Configuration of multiple-linear-regression analysis (diamlr) 
    1717       ===================================================================================================== 
    18         
     18 
    1919       This field group configures diamlr for tidal harmonic analysis of field 
    2020       ssh: in addition to a regressor for fitting the mean value (diamlr_r101), 
     
    7373 
    7474    </field_group> 
    75      
    76     <!--  
     75 
     76    <!-- 
    7777============================================================================================================ 
    7878=                                  definition of all existing variables                                    = 
     
    101101    </field_group> 
    102102 
    103     <!--  
     103    <!-- 
    104104============================================================================================================ 
    105105                                  Physical ocean model variables 
     
    108108 
    109109      <!-- T grid --> 
    110        
     110 
    111111      <field_group id="grid_T" grid_ref="grid_T_2D" > 
    112112        <field id="e3t"          long_name="T-cell thickness"                    standard_name="cell_thickness"        unit="m"   grid_ref="grid_T_3D" /> 
    113113        <field id="e3ts"         long_name="T-cell thickness"   field_ref="e3t"  standard_name="cell_thickness"        unit="m"   grid_ref="grid_T_SFC"/> 
    114114        <field id="e3t_0"        long_name="Initial T-cell thickness"            standard_name="ref_cell_thickness"    unit="m"   grid_ref="grid_T_3D" /> 
    115         <field id="e3tb"         long_name="bottom T-cell thickness"             standard_name="bottom_cell_thickness" unit="m"   grid_ref="grid_T_2D"/>  
     115        <field id="e3tb"         long_name="bottom T-cell thickness"             standard_name="bottom_cell_thickness" unit="m"   grid_ref="grid_T_2D"/> 
    116116        <field id="e3t_300"      field_ref="e3t"                grid_ref="grid_T_zoom_300"       detect_missing_value="true" /> 
    117117        <field id="e3t_vsum300"  field_ref="e3t_300"            grid_ref="grid_T_vsum"   detect_missing_value="true" /> 
    118118   <field id="masscello"    long_name="Sea Water Mass per unit area"   standard_name="sea_water_mass_per_unit_area"   unit="kg/m2"   grid_ref="grid_T_3D"/> 
    119         <field id="volcello"     long_name="Ocean Volume"                   standard_name="ocean_volume"   unit="m3"       grid_ref="grid_T_3D"/>  
     119        <field id="volcello"     long_name="Ocean Volume"                   standard_name="ocean_volume"   unit="m3"       grid_ref="grid_T_3D"/> 
    120120        <field id="toce"         long_name="temperature"                         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/> 
    121121        <field id="toce_e3t"     long_name="temperature (thickness weighted)"                                                      unit="degC"     grid_ref="grid_T_3D" > toce * e3t </field > 
     
    146146        <field id="sst_cs"       long_name="Delta SST of cool skin"                                                                                 unit="degC"     /> 
    147147   <field id="temp_3m"      long_name="temperature at 3m"                                                                                      unit="degC"     /> 
    148          
     148 
    149149        <field id="sss"          long_name="sea surface salinity"                               standard_name="sea_surface_salinity"                unit="1e-3"     /> 
    150150        <field id="sss2"         long_name="square of sea surface salinity"                                                                         unit="1e-6"      > sss * sss </field > 
     
    152152        <field id="sssmin"       long_name="min of sea surface salinity"      field_ref="sss"   operation="minimum"                                                 /> 
    153153        <field id="sbs"          long_name="sea bottom salinity"                                                                                    unit="0.001"    /> 
    154         <field id="somint"       long_name="vertical integral of salinity times density"        standard_name="integral_wrt_depth_of_product_of_density_and_salinity"  unit="(kg m2) x (1e-3)" />  
    155  
    156         <field id="taubot"       long_name="bottom stress module"                                                                                   unit="N/m2"     />  
     154        <field id="somint"       long_name="vertical integral of salinity times density"        standard_name="integral_wrt_depth_of_product_of_density_and_salinity"  unit="(kg m2) x (1e-3)" /> 
     155 
     156        <field id="taubot"       long_name="bottom stress module"                                                                                   unit="N/m2"     /> 
    157157 
    158158         <!-- Case EOS = TEOS-10 : output potential temperature --> 
     
    295295        <field id="us_y"        long_name="j component of Stokes drift"                      unit="m/s"     /> 
    296296      </field_group> 
    297        
     297 
    298298      <!-- SBC --> 
    299299      <field_group id="SBC" > <!-- time step automaticaly defined based on nn_fsbc --> 
     
    311311          <field id="precip"       long_name="Total precipitation"                  standard_name="precipitation_flux"                                                   unit="kg/m2/s"   /> 
    312312          <field id="wclosea"      long_name="closed sea empmr correction"          standard_name="closea_empmr"                                                         unit="kg/m2/s"   /> 
    313       
     313 
    314314          <field id="qt"           long_name="Net Downward Heat Flux"                standard_name="surface_downward_heat_flux_in_sea_water"                              unit="W/m2"                           /> 
    315315          <field id="qns"          long_name="non solar Downward Heat Flux"                                                                                               unit="W/m2"                           /> 
     
    321321          <field id="taum"         long_name="wind stress module"                    standard_name="magnitude_of_surface_downward_stress"                                 unit="N/m2"                           /> 
    322322          <field id="wspd"         long_name="wind speed module"                     standard_name="wind_speed"                                                           unit="m/s"                            /> 
    323            
     323 
    324324          <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn --> 
    325325          <field id="ssh_ib"       long_name="Inverse barometer sea surface height"  standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency"   unit="m"        /> 
     
    369369          <field id="taum_oce"     long_name="wind stress module over open ocean"           standard_name="magnitude_of_surface_downward_stress"               unit="N/m2"  /> 
    370370 
     371          <!-- variables computed by the bulk parameterization algorithms (ln_blk) --> 
     372          <field id="Cd_oce"      long_name="Drag coefficient over open ocean"              standard_name="drag_coefficient_water"                unit=""  /> 
     373          <field id="Ce_oce"      long_name="Evaporaion coefficient over open ocean"        standard_name="evap_coefficient_water"                unit=""  /> 
     374          <field id="Ch_oce"      long_name="Sensible heat coefficient over open ocean"     standard_name="sensible_heat_coefficient_water"       unit=""  /> 
     375          <field id="theta_zt"    long_name="Potential air temperature at z=zt"             standard_name="potential_air_temperature_at_zt"       unit="degC" /> 
     376          <field id="q_zt"        long_name="Specific air humidity at z=zt"                 standard_name="specific_air_humidity_at_zt"           unit="kg/kg" /> 
     377          <field id="theta_zu"    long_name="Potential air temperature at z=zu"             standard_name="potential_air_temperature_at_zu"       unit="degC" /> 
     378          <field id="q_zu"        long_name="Specific air humidity at z=zu"                 standard_name="specific_air_humidity_at_zu"           unit="kg/kg" /> 
     379          <field id="ssq"         long_name="Saturation specific humidity of air at z=0"    standard_name="surface_air_saturation_spec_humidity"  unit="kg/kg" /> 
     380          <field id="wspd_blk"    long_name="Bulk wind speed at z=zu"                       standard_name="bulk_wind_speed_at_zu"                 unit="m/s"   /> 
     381          <!-- ln_blk + key_si3 --> 
     382          <field id="Cd_ice"      long_name="Drag coefficient over ice"                     standard_name="drag_coefficient_ice"                 unit=""  /> 
     383          <field id="Ce_ice"      long_name="Evaporaion coefficient over ice"               standard_name="evap_coefficient_ice"                 unit=""  /> 
     384          <field id="Ch_ice"      long_name="Sensible heat coefficient over ice"            standard_name="sensible_heat_coefficient_ice"        unit=""  /> 
     385 
    371386          <!-- available key_oasis3 --> 
    372387          <field id="snow_ao_cea"  long_name="Snow over ice-free ocean (cell average)"   standard_name="snowfall_flux"                             unit="kg/m2/s"  /> 
     
    405420          <!-- ice field (nn_ice=1)  --> 
    406421          <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            /> 
    407            
     422 
    408423          <!-- dilution --> 
    409424          <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                                                                                              unit="kg*degC/m2/s" /> 
    410           <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" />         
     425          <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" /> 
    411426          <field id="rnf_x_sst"    long_name="Runoff term on SST"                                                                                                              unit="kg*degC/m2/s" /> 
    412427          <field id="rnf_x_sss"    long_name="Runoff term on SSS"                                                                                                              unit="kg*1e-3/m2/s" /> 
    413       
     428 
    414429     <!-- sbcssm variables --> 
    415430          <field id="sst_m"    unit="degC" /> 
     
    422437 
    423438   </field_group> 
    424     
     439 
    425440 
    426441      </field_group> <!-- SBC --> 
    427        
     442 
    428443      <!-- ABL --> 
    429444      <field_group id="ABL" > <!-- time step automaticaly defined based on nn_fsbc --> 
     
    458473          <field id="uz1_dta"    long_name="DTA i-horizontal velocity"     standard_name="dta_x_velocity" unit="m/s"      /> 
    459474          <field id="vz1_dta"    long_name="DTA j-horizontal velocity"     standard_name="dta_y_velocity" unit="m/s"      /> 
    460           <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>  
     475          <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> 
    461476          <field id="tz1_dta"    long_name="DTA potential temperature"     standard_name="dta_theta"      unit="K"        /> 
    462477          <field id="qz1_dta"    long_name="DTA specific humidity"         standard_name="dta_qspe"       unit="kg/kg"    /> 
     
    464479          <field id="uz1_geo"    long_name="GEO i-horizontal velocity"     standard_name="geo_x_velocity" unit="m/s"      /> 
    465480          <field id="vz1_geo"    long_name="GEO j-horizontal velocity"     standard_name="geo_y_velocity" unit="m/s"      /> 
    466           <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>  
     481          <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> 
    467482   </field_group> 
    468483 
    469484      </field_group> <!-- ABL --> 
    470485 
    471        
     486 
    472487      <!-- U grid --> 
    473        
     488 
    474489      <field_group id="grid_U"   grid_ref="grid_U_2D"> 
    475490        <field id="e2u"           long_name="U-cell width in meridional direction"                   standard_name="cell_width"                  unit="m"                               /> 
     
    480495      <field id="uoce_e3u"      long_name="ocean current along i-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_U_3D"  > uoce * e3u </field> 
    481496      <field id="uoce_e3u_vsum" long_name="ocean current along i-axis * e3u summed on the vertical"  field_ref="uoce_e3u"    unit="m3/s"       grid_ref="grid_U_vsum"/> 
    482         <field id="uocetr_vsum"   long_name="ocean transport along i-axis  summed on the vertical"         field_ref="e2u"       unit="m3/s"> this * uoce_e3u_vsum  </field>  
     497        <field id="uocetr_vsum"   long_name="ocean transport along i-axis  summed on the vertical"         field_ref="e2u"       unit="m3/s"> this * uoce_e3u_vsum  </field> 
    483498 
    484499        <field id="uocetr_vsum_op"    long_name="ocean current along i-axis * e3u * e2u summed on the vertical"  read_access="true"  freq_op="1mo"    field_ref="e2u"       unit="m3/s"> @uocetr_vsum </field> 
    485         <field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo"  unit="m3/s" />  
     500        <field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo"  unit="m3/s" /> 
    486501        <field id="msftbarot"         long_name="ocean_barotropic_mass_streamfunction"   unit="kg s-1" > uocetr_vsum_cumul * $rau0 </field> 
    487502 
     
    536551        <field id="udiff_salttr"  long_name="ocean diffusion salt transport along i-axis"                     standard_name="ocean_salt_x_transport_due_to_diffusion"        unit="1e-3*kg/s"                 /> 
    537552      </field_group> 
    538        
     553 
    539554      <!-- V grid --> 
    540        
     555 
    541556      <field_group id="grid_V"   grid_ref="grid_V_2D"> 
    542557        <field id="e1v"          long_name="V-cell width in longitudinal direction"                 standard_name="cell_width"                  unit="m"                              /> 
     
    595610        <field id="vdiff_salttr"  long_name="ocean diffusion salt transport along j-axis"   standard_name="ocean_salt_y_transport_due_to_diffusion"         unit="1e-3*kg/s"                 /> 
    596611      </field_group> 
    597        
     612 
    598613      <!-- W grid --> 
    599        
     614 
    600615      <field_group id="grid_W" grid_ref="grid_W_3D"> 
    601616        <field id="e3w"          long_name="W-cell thickness"                              standard_name="cell_thickness"                         unit="m"    /> 
    602617   <field id="woce"         long_name="ocean vertical velocity"                       standard_name="upward_sea_water_velocity"              unit="m/s"  /> 
    603    <field id="woce_e3w"     long_name="ocean vertical velocity * e3w"                                                                        unit="m2/s"  > woce * e3w </field>   
     618   <field id="woce_e3w"     long_name="ocean vertical velocity * e3w"                                                                        unit="m2/s"  > woce * e3w </field> 
    604619        <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                                                   unit="m3/s" /> 
    605620 
     
    611626 
    612627   <field id="avt"          long_name="vertical eddy diffusivity"                      standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    613         <field id="avt_e3w"      long_name="vertical heat diffusivity * e3w"                unit="m3/s" > avt * e3w </field>      
     628        <field id="avt_e3w"      long_name="vertical heat diffusivity * e3w"                unit="m3/s" > avt * e3w </field> 
    614629        <field id="logavt"       long_name="logarithm of vertical eddy diffusivity"         standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    615630        <field id="avm"          long_name="vertical eddy viscosity"                        standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" /> 
    616         <field id="avm_e3w"      long_name="vertical eddy viscosity * e3w"   unit="m3/s" > avm * e3w </field>  
     631        <field id="avm_e3w"      long_name="vertical eddy viscosity * e3w"   unit="m3/s" > avm * e3w </field> 
    617632 
    618633        <!-- avs: /= avt with ln_zdfddm=T --> 
    619634        <field id="avs"          long_name="salt vertical eddy diffusivity"                 standard_name="ocean_vertical_salt_diffusivity"       unit="m2/s" /> 
    620         <field id="avs_e3w"      long_name="vertical salt diffusivity * e3w"   unit="m3/s" > avs * e3w </field>  
     635        <field id="avs_e3w"      long_name="vertical salt diffusivity * e3w"   unit="m3/s" > avs * e3w </field> 
    621636   <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"    standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    622637 
    623638        <!-- avt_evd and avm_evd: available with ln_zdfevd --> 
    624639        <field id="avt_evd"      long_name="convective enhancement of vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" /> 
    625         <field id="avt_evd_e3w"  long_name="convective enhancement to vertical diffusivity * e3w "    unit="m3/s" > avt_evd * e3w </field>  
     640        <field id="avt_evd_e3w"  long_name="convective enhancement to vertical diffusivity * e3w "    unit="m3/s" > avt_evd * e3w </field> 
    626641   <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"   standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" /> 
    627642 
     
    636651        <field id="wstokes"      long_name="Stokes Drift vertical velocity"                 standard_name="upward_StokesDrift_velocity"   unit="m/s" /> 
    637652 
    638         <!-- variables available with diaar5 -->    
     653        <!-- variables available with diaar5 --> 
    639654        <field id="w_masstr"     long_name="vertical mass transport"                        standard_name="upward_ocean_mass_transport"             unit="kg/s"   /> 
    640655        <field id="w_masstr2"    long_name="square of vertical mass transport"              standard_name="square_of_upward_ocean_mass_transport"   unit="kg2/s2" /> 
    641656 
    642657      </field_group> 
    643        
     658 
    644659      <!-- F grid --> 
    645660      <!-- AGRIF sponge --> 
     
    696711      </field_group> 
    697712 
    698        
     713 
    699714      <!-- variables available with ln_floats --> 
    700715 
     
    711726      <!-- variables available with iceberg trajectories --> 
    712727 
    713       <field_group id="icbvar" domain_ref="grid_T"  >  
     728      <field_group id="icbvar" domain_ref="grid_T"  > 
    714729        <field id="berg_melt"          long_name="icb melt rate of icebergs"                       unit="kg/m2/s"                    /> 
    715730        <field id="berg_melt_hcflx"    long_name="icb heat flux to ocean due to melting heat content"   unit="J/m2/s"                /> 
     
    729744      </field_group> 
    730745 
    731       <!-- Poleward transport : ptr -->      
    732       <field_group id="diaptr" >   
     746      <!-- Poleward transport : ptr --> 
     747      <field_group id="diaptr" > 
    733748        <field id="zomsf"         long_name="Overturning Stream-Function : All basins"                     unit="Sv"         grid_ref="grid_znl_W_3D" /> 
    734749        <field id="zotem"         long_name="Zonal Mean Temperature : All basins"                          unit="degree_C"   grid_ref="grid_znl_T_3D" /> 
     
    738753        <field id="sopstove"      long_name="Overturning Salt Transport: All basins"                       unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    739754        <field id="sophtbtr"      long_name="Barotropic Heat Transport: All basins"                        unit="PW"         grid_ref="grid_znl_T_2D" /> 
    740         <field id="sopstbtr"      long_name="Barotropic Salt Transport: All basins"                        unit="Giga g/s"   grid_ref="grid_znl_T_2D" />  
     755        <field id="sopstbtr"      long_name="Barotropic Salt Transport: All basins"                        unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    741756        <field id="sophtadv"      long_name="Advective Heat Transport: All basins"                         unit="PW"         grid_ref="grid_znl_T_2D" /> 
    742757        <field id="sopstadv"      long_name="Advective Salt Transport: All basins"                         unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
     
    744759        <field id="sopstldf"      long_name="Diffusive Salt Transport: All basins"                         unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    745760        <field id="sophtvtr"      long_name="Heat Transport : All basins"                                  unit="PW"         grid_ref="grid_znl_T_2D" /> 
    746         <field id="sopstvtr"      long_name="Salt Transport : All basins"                                  unit="Giga g/s"   grid_ref="grid_znl_T_2D" />   
     761        <field id="sopstvtr"      long_name="Salt Transport : All basins"                                  unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    747762        <field id="sophteiv"      long_name="Heat Transport from mesoscale eddy advection: All basins"     unit="PW"         grid_ref="grid_znl_T_2D" /> 
    748763        <field id="sopsteiv"      long_name="Salt Transport from mesoscale eddy advection : All basins"    unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
     
    760775 
    761776 
    762     <!--  
     777    <!-- 
    763778============================================================================================================ 
    764779                  Physical ocean model trend diagnostics : temperature, KE, PE, momentum 
     
    901916     <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                    unit="W/s^3"                        /> 
    902917     <field id="ketrd_tau"     long_name="ke-trend: wind stress "                           unit="W/s^3"   grid_ref="grid_T_2D" /> 
    903      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        />    
    904      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        />    
    905      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        />   
     918     <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        /> 
     919     <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        /> 
     920     <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        /> 
    906921     <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"      unit="W/s^3"                        /> 
    907      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        />    
     922     <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        /> 
    908923 
    909924     <!-- variables available when explicit lateral mixing is used (ln_dynldf_OFF=F) --> 
    910      <field id="dispkexyfo"    long_name="KE-trend: lateral  mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction"                   unit="W/m^2" grid_ref="grid_T_2D" />    
    911      <field id="dispkevfo"     long_name="KE-trend: vertical mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction"             unit="W/m^2" grid_ref="grid_T_2D" />    
     925     <field id="dispkexyfo"    long_name="KE-trend: lateral  mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction"                   unit="W/m^2" grid_ref="grid_T_2D" /> 
     926     <field id="dispkevfo"     long_name="KE-trend: vertical mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction"             unit="W/m^2" grid_ref="grid_T_2D" /> 
    912927     <!-- variables available with ln_traadv_eiv=T and ln_diaeiv=T --> 
    913      <field id="eketrd_eiv"    long_name="EKE-trend due to parameterized eddy advection"   standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection"   unit="W/m^2" grid_ref="grid_T_2D" />    
     928     <field id="eketrd_eiv"    long_name="EKE-trend due to parameterized eddy advection"   standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection"   unit="W/m^2" grid_ref="grid_T_2D" /> 
    914929 
    915930     <!-- variables available with ln_PE_trd --> 
     
    928943     <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"         unit="W/m^3"                        /> 
    929944     <field id="petrd_atf"     long_name="pe-trend: asselin time filter"        unit="W/m^3"                        /> 
    930      <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            />    
    931      <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degC-1"                       />    
    932      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          />    
     945     <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            /> 
     946     <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degC-1"                       /> 
     947     <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          /> 
    933948   </field_group> 
    934949 
     
    947962     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                    unit="m/s^2"                        /> 
    948963     <field id="utrd_tau"       long_name="i-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_U_2D" /> 
    949      <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        />    
    950      <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        />    
    951      <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        />    
    952      <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        />    
     964     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        /> 
     965     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        /> 
     966     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        /> 
     967     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        /> 
    953968   </field_group> 
    954969 
     
    967982     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                    unit="m/s^2"                        /> 
    968983     <field id="vtrd_tau"       long_name="j-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_V_2D" /> 
    969      <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        />    
    970      <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        />    
    971      <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        />    
    972      <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        />    
     984     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        /> 
     985     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        /> 
     986     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        /> 
     987     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        /> 
    973988   </field_group> 
    974989 
    975990 
    976     <!--  
     991    <!-- 
    977992============================================================================================================ 
    978993                                        Definitions for iodef_demo.xml 
     
    9921007      <field field_ref="strd_zdfp_li"    name="osaltdiff" /> 
    9931008    </field_group> 
    994      
     1009 
    9951010    <field_group id="mooring" > 
    9961011      <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"      /> 
     
    10011016      <field field_ref="avt"          name="difvho"   long_name="ocean_vertical_heat_diffusivity"      /> 
    10021017      <field field_ref="avm"          name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"  /> 
    1003        
     1018 
    10041019      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
    10051020      <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             /> 
     
    10491064      <field field_ref="BLT"          name="blt"      long_name="Barrier Layer Thickness"                       /> 
    10501065    </field_group> 
    1051      
     1066 
    10521067    <field_group id="groupU" > 
    10531068      <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      /> 
    10541069      <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" /> 
    10551070    </field_group> 
    1056      
     1071 
    10571072    <field_group id="groupV" > 
    10581073      <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      /> 
    10591074      <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" /> 
    10601075    </field_group> 
    1061      
     1076 
    10621077    <field_group id="groupW" > 
    10631078      <field field_ref="woce"         name="wo"       long_name="ocean vertical velocity"  /> 
     
    11021117    </field_group> 
    11031118 
    1104     <!--  
     1119    <!-- 
    11051120============================================================================================================ 
    11061121    --> 
    1107     <!-- output variables for my configuration (example) -->  
    1108      
     1122    <!-- output variables for my configuration (example) --> 
     1123 
    11091124    <field_group id="myvarOCE" > 
    1110       <!-- grid T -->  
     1125      <!-- grid T --> 
    11111126      <field field_ref="e3t"          name="e3t"      long_name="vertical scale factor"           /> 
    11121127      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"         /> 
    11131128      <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"            /> 
    11141129      <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"  /> 
    1115        
    1116       <!-- grid U -->  
     1130 
     1131      <!-- grid U --> 
    11171132      <field field_ref="e3u"          name="e3u"     long_name="vertical scale factor"            /> 
    11181133      <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"           /> 
    1119        
    1120       <!-- grid V -->  
     1134 
     1135      <!-- grid V --> 
    11211136      <field field_ref="e3v"          name="e3v"     long_name="vertical scale factor"            /> 
    1122       <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"           />      
    1123     </field_group>     
     1137      <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"           /> 
     1138    </field_group> 
    11241139 
    11251140   </field_definition> 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/SHARED/namelist_pisces_ref

    r12377 r13159  
    352352! 
    353353   cn_dir      = './'      !  root directory for the location of the dynamical files 
    354    ln_ironsed  =  .true.   ! boolean for Fe input from sediments 
    355    ln_ironice  =  .true.   ! boolean for Fe input from sea ice 
    356    ln_hydrofe  =  .true.   ! boolean for from hydrothermal vents 
     354   ln_ironsed  =  .false.   ! boolean for Fe input from sediments 
     355   ln_ironice  =  .false.   ! boolean for Fe input from sea ice 
     356   ln_hydrofe  =  .false.   ! boolean for from hydrothermal vents 
    357357   sedfeinput  =  2.e-9    ! Coastal release of Iron 
    358358   distcoast   =  5.e3     ! Distance off the coast for Iron from sediments 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/SHARED/namelist_ref

    r12749 r13159  
    259259!----------------------------------------------------------------------- 
    260260   !                    !  bulk algorithm : 
    261    ln_NCAR      = .false.   ! "NCAR"      algorithm   (Large and Yeager 2008) 
     261   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    262262   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    263263   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     
    271271      rn_pfac    = 1.       !  multipl. factor for precipitation (total & snow) 
    272272      rn_efac    = 1.       !  multipl. factor for evaporation (0. or 1.) 
    273       rn_vfac    = 1.       !  multipl. factor for ocean & ice velocity 
     273      rn_vfac    = 0.       !  multipl. factor for ocean & ice velocity 
    274274      !                     !  used to calculate the wind stress 
    275275      !                     ! (0. => absolute or 1. => relative winds) 
     
    277277      ln_skin_wl = .false.  !  use the warm-layer parameterization 
    278278      !                     !   ==> only available in ECMWF and COARE algorithms 
    279       ln_humi_sph = .false. !  humidity "sn_humi" is specific humidity  [kg/kg] 
     279      ln_humi_sph = .true. !  humidity "sn_humi" is specific humidity  [kg/kg] 
    280280      ln_humi_dpt = .false. !  humidity "sn_humi" is dew-point temperature [K] 
    281281      ln_humi_rlh = .false. !  humidity "sn_humi" is relative humidity     [%] 
     
    11381138   !                       !                 = 3 as =2 with distinct dissipative an mixing length scale 
    11391139   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F) 
     1140      nn_mxlice    = 0        ! type of scaling under sea-ice 
     1141                              !    = 0 no scaling under sea-ice 
     1142                              !    = 1 scaling with constant sea-ice thickness 
     1143                              !    = 2  scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
     1144                              !    = 3  scaling with maximum sea-ice thickness 
     1145      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    11401146   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
    11411147   ln_drg      = .false.   !  top/bottom friction added as boundary condition of TKE 
     
    13981404&namctl        !   Control prints                                       (default: OFF) 
    13991405!----------------------------------------------------------------------- 
    1400    sn_cfctl%l_glochk = .FALSE.    ! Range sanity checks are local (F) or global (T). Set T for debugging only 
    1401    sn_cfctl%l_allon  = .FALSE.    ! IF T activate all options. If F deactivate all unless l_config is T 
    1402      sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the following 
    1403        sn_cfctl%l_runstat = .TRUE.  ! switches and which areas produce reports with the proc integer settings. 
    1404        sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 
    1405        sn_cfctl%l_oceout  = .FALSE. ! that  all areas report. 
    1406        sn_cfctl%l_layout  = .FALSE. ! 
    1407        sn_cfctl%l_prtctl  = .FALSE. ! 
    1408        sn_cfctl%l_prttrc  = .FALSE. ! 
    1409        sn_cfctl%l_oasout  = .FALSE. ! 
    1410        sn_cfctl%procmin   = 0       ! Minimum area number for reporting [default:0] 
    1411        sn_cfctl%procmax   = 1000000 ! Maximum area number for reporting [default:1000000] 
    1412        sn_cfctl%procincr  = 1       ! Increment for optional subsetting of areas [default:1] 
    1413        sn_cfctl%ptimincr  = 1       ! Timestep increment for writing time step progress info 
    1414    nn_print    =    0      !  level of print (0 no extra print) 
    1415    nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus 
    1416    nn_ictle    =    0      !  end   i indice of control sum        multi processor runs 
    1417    nn_jctls    =    0      !  start j indice of control               over a subdomain) 
    1418    nn_jctle    =    0      !  end   j indice of control 
    1419    nn_isplt    =    1      !  number of processors in i-direction 
    1420    nn_jsplt    =    1      !  number of processors in j-direction 
    1421    ln_timing   = .false.   !  timing by routine write out in timing.output file 
    1422    ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
     1406   sn_cfctl%l_runstat = .TRUE.    ! switches and which areas produce reports with the proc integer settings. 
     1407   sn_cfctl%l_trcstat = .FALSE.   ! The default settings for the proc integers should ensure 
     1408   sn_cfctl%l_oceout  = .FALSE.   ! that  all areas report. 
     1409   sn_cfctl%l_layout  = .FALSE.   ! 
     1410   sn_cfctl%l_prtctl  = .FALSE.   ! 
     1411   sn_cfctl%l_prttrc  = .FALSE.   ! 
     1412   sn_cfctl%l_oasout  = .FALSE.   ! 
     1413   sn_cfctl%procmin   = 0         ! Minimum area number for reporting [default:0] 
     1414   sn_cfctl%procmax   = 1000000   ! Maximum area number for reporting [default:1000000] 
     1415   sn_cfctl%procincr  = 1         ! Increment for optional subsetting of areas [default:1] 
     1416   sn_cfctl%ptimincr  = 1         ! Timestep increment for writing time step progress info 
     1417   nn_print    =    0             !  level of print (0 no extra print) 
     1418   nn_ictls    =    0             !  start i indice of control sum (use to compare mono versus 
     1419   nn_ictle    =    0             !  end   i indice of control sum        multi processor runs 
     1420   nn_jctls    =    0             !  start j indice of control               over a subdomain) 
     1421   nn_jctle    =    0             !  end   j indice of control 
     1422   nn_isplt    =    1             !  number of processors in i-direction 
     1423   nn_jsplt    =    1             !  number of processors in j-direction 
     1424   ln_timing   = .false.          !  timing by routine write out in timing.output file 
     1425   ln_diacfl   = .false.          !  CFL diagnostics write out in cfl_diagnostics.ascii 
    14231426/ 
    14241427!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/WED025/EXPREF/file_def_nemo-ice.xml

    r11844 r13159  
    7878     </file> 
    7979      
    80      <file id="file22" name_suffix="_SBC_scalar" description="scalar variables" enabled=".true." > 
    81        <!-- global contents --> 
    82        <field field_ref="ibgvol_tot"     grid_ref="grid_1point"   name="ibgvol_tot"   /> 
    83        <field field_ref="sbgvol_tot"     grid_ref="grid_1point"   name="sbgvol_tot"   /> 
    84        <field field_ref="ibgarea_tot"    grid_ref="grid_1point"   name="ibgarea_tot"  /> 
    85        <field field_ref="ibgsalt_tot"    grid_ref="grid_1point"   name="ibgsalt_tot"  /> 
    86        <field field_ref="ibgheat_tot"    grid_ref="grid_1point"   name="ibgheat_tot"  /> 
    87        <field field_ref="sbgheat_tot"    grid_ref="grid_1point"   name="sbgheat_tot"  /> 
    88         
    89        <!-- global drifts (conservation checks) --> 
    90        <field field_ref="ibgvolume"      grid_ref="grid_1point"   name="ibgvolume"    /> 
    91        <field field_ref="ibgsaltco"      grid_ref="grid_1point"   name="ibgsaltco"    /> 
    92        <field field_ref="ibgheatco"      grid_ref="grid_1point"   name="ibgheatco"    /> 
    93        <field field_ref="ibgheatfx"      grid_ref="grid_1point"   name="ibgheatfx"    /> 
    94         
    95        <!-- global forcings  --> 
    96        <field field_ref="ibgfrcvoltop"   grid_ref="grid_1point"   name="ibgfrcvoltop" /> 
    97        <field field_ref="ibgfrcvolbot"   grid_ref="grid_1point"   name="ibgfrcvolbot" /> 
    98        <field field_ref="ibgfrctemtop"   grid_ref="grid_1point"   name="ibgfrctemtop" /> 
    99        <field field_ref="ibgfrctembot"   grid_ref="grid_1point"   name="ibgfrctembot" /> 
    100        <field field_ref="ibgfrcsal"      grid_ref="grid_1point"   name="ibgfrcsal"    /> 
    101        <field field_ref="ibgfrchfxtop"   grid_ref="grid_1point"   name="ibgfrchfxtop" /> 
    102        <field field_ref="ibgfrchfxbot"   grid_ref="grid_1point"   name="ibgfrchfxbot" /> 
    103      </file> 
    104       
    10580   </file_group> 
    10681    
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/WED025/EXPREF/namelist_cfg

    r12489 r13159  
    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!!                                    namisf, namsbc_apr,  
    88!!                                    namsbc_ssr, namsbc_wave, namberg) 
    99!!              3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) 
     
    3838   nn_it000    =   1       !  first time step 
    3939   nn_itend    =  26280    !  last  time step (std 5475) 
    40    nn_date0    = 19760301  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     40   nn_date0    = 20000101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    4141   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    4242      nn_rstctl   =    2      !  restart control ==> activated only if ln_rstart=T 
     
    6161   ln_tsd_init = .true.          !  ocean initialisation 
    6262   ln_tsd_dmp  = .false.         !  T-S restoring   (see namtra_dmp) 
    63     
     63 
    6464   cn_dir      = './'      !  root directory for the T-S data location 
    65    !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    66    !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    67    !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    68    sn_tem = 'dta_temp_WED025'            ,         -12       , 'votemper',   .true.    , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
    69    sn_sal = 'dta_sal_WED025'             ,         -12       , 'vosaline',   .true.    , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
     65   !___________!_____________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
     66   !           !  file name          ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     67   !           !                     !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
     68   sn_tem = 'WED025_init_JRA_200001.nc',       -12       , 'votemper',   .false.   , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
     69   sn_sal = 'WED025_init_JRA_200001.nc',       -12       , 'vosaline',   .false.   , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
    7070/ 
    7171!----------------------------------------------------------------------- 
     
    116116   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    117117                     ! Sea-ice : 
    118    nn_ice      = 2         !  =0 no ice boundary condition     
     118   nn_ice      = 2         !  =0 no ice boundary condition 
    119119      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
    120       !                    !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    121       !                    !          except in AGRIF zoom where it has to be specified 
     120      !                    !  =2 or 3 for SI3 and CICE, respectively 
    122121   ln_ice_embd = .false.   !  =T embedded sea-ice (pressure + mass and salt exchanges) 
    123122      !                    !  =F levitating ice (no pressure, mass and salt exchanges) 
    124123                     ! Misc. options of sbc :  
    125124   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
    126    ln_dm2dc    = .true.    !  daily mean to diurnal cycle on short wave 
     125   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    127126   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    128127   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
     
    141140   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008) 
    142141   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    143    ln_COARE_3p5 = .false.   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    144    ln_ECMWF    = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     142   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     143   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    145144 
    146145   cn_dir      = './'      !  root directory for the bulk data location 
     
    148147   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
    149148   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                                      ! pairing  !    filename   ! 
    150    sn_wndi     = 'u10_core'              ,         6         , 'U_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bicubic_core.nc'           , 'Uwnd'   , '' 
    151    sn_wndj     = 'v10_core'              ,         6         , 'V_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bicubic_core.nc'           , 'Vwnd'   , '' 
    152    sn_qsr      = 'qsw_core'              ,        24         , 'SWDN_MOD',   .false.   , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    153    sn_qlw      = 'qlw_core'              ,        24         , 'LWDN_MOD',   .false.   , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    154    sn_tair     = 't10_core'              ,         6         , 'T_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    155    sn_humi     = 'q10_core'              ,         6         , 'Q_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    156    sn_prec     = 'precip_core'           ,        -1         , 'TPRECIP',    .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    157    sn_snow     = 'snow_core'             ,        -1         , 'SNOW'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    158    sn_slp      = 'slp_core'              ,         6         , 'SLP'     ,   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
     149   sn_wndi     = 'u10_JRA'              ,         3         , 'uas_10m' ,   .true.    , .false. , 'yearly'  , 'weights_bicubic_JRA.nc'           , 'Uwnd'   , '' 
     150   sn_wndj     = 'v10_JRA'              ,         3         , 'vas_10m' ,   .true.    , .false. , 'yearly'  , 'weights_bicubic_JRA.nc'           , 'Vwnd'   , '' 
     151   sn_qsr      = 'rsds_JRA'             ,         3         , 'rsds'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     152   sn_qlw      = 'rlds_JRA'             ,         3         , 'rlds'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     153   sn_tair     = 't10_JRA'              ,         3         , 'tas_10m' ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     154   sn_humi     = 'q10_JRA'              ,         3         , 'huss_10m',   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     155   sn_prec     = 'precip_JRA'           ,         3         , 'prto'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     156   sn_snow     = 'snow_JRA'             ,         3         , 'prsn'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     157   sn_slp      = 'slp_JRA'              ,         3         , 'psl'     ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
    159158/ 
    160159!----------------------------------------------------------------------- 
     
    201200   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    202201   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    203    sn_rnf      = 'runoff_WED025'         ,  -1               , 'runoff'  ,   .true.    , .false., 'yearly'  , ''               , ''       , '' 
     202   sn_rnf      = 'WED025_icb'         ,  -1               , 'runoff'  ,   .true.    , .false., 'yearly'  , ''               , ''       , '' 
    204203/ 
    205204!----------------------------------------------------------------------- 
     
    221220         cn_isfcav_mlt = '3eq'   ! ice shelf melting formulation (spe/2eq/3eq/oasis) 
    222221         !                       ! spe = fwfisf is read from a forcing field 
    223          !                       ! 2eq = ISOMIP  like: 2 equations formulation (Hunter et al., 2006) 
    224          !                       ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015) 
     222         !                       ! 2eq = ISOMIP  like: 2 equations formulation (Hunter et al., 2006 for a short description) 
     223         !                       ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2016 for a short description) 
    225224         !                       ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf 
    226225         !              !  cn_isfcav_mlt = 2eq or 3eq cases: 
    227226         cn_gammablk = 'vel'     ! scheme to compute gammat/s (spe,ad15,hj99) 
    228          !                       ! ad15 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010) 
    229          !                       ! hj99 = velocity and stability dependent Gamma    (Holland et al. 1999) 
    230          rn_gammat0  = 1.4e-2    ! gammat coefficient used in blk formula 
    231          rn_gammas0  = 4.e-4    ! gammas coefficient used in blk formula 
     227         !                       ! spe      = constant transfert velocity (rn_gammat0, rn_gammas0) 
     228         !                       ! vel      = velocity dependent transfert velocity (u* * gammat/s) (Asay-Davis et al. 2016 for a short description) 
     229         !                       ! vel_stab = velocity and stability dependent transfert coeficient (Holland et al. 1999 for a complete description) 
     230         rn_gammat0  = 1.4e-2    ! gammat coefficient used in spe, vel and vel_stab gamma computation method 
     231         rn_gammas0  = 4.0e-4    ! gammas coefficient used in spe, vel and vel_stab gamma computation method 
    232232         ! 
    233233         rn_htbl     =  30.      ! thickness of the top boundary layer    (Losh et al. 2008) 
     
    255255         sn_isfpar_zmin = 'isfmlt_par',      -12.      , 'sozisfmin' ,  .false.    , .true.  , 'yearly'  ,    ''    ,   ''     ,    '' 
    256256         !* 'spe' and 'oasis' case 
    257          sn_isfpar_fwf = 'isfmlt_par' ,      -12.      , 'sofwfisf' ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
     257         sn_isfpar_fwf = 'isfmlt_par' ,      -12.      ,'sofwfisf' ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
    258258         !* 'bg03' case 
    259          sn_isfpar_Leff = 'isfmlt_par',       0.       , 'Leff'     ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
     259         sn_isfpar_Leff = 'isfmlt_par',       0.       ,'Leff'     ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
    260260      ! 
    261261      ! ---------------- ice sheet coupling ------------------------------- 
     
    300300   ln_tide     = .true.       ! Activate tides 
    301301      ln_tide_pot   = .false.               !  use tidal potential forcing 
    302       clname(1) = 'M2'  !  name of constituent - all tidal components must be set in namelist_cfg 
    303       clname(2) = 'S2' 
    304       clname(3) = 'K1' 
    305       clname(4) = 'O1' 
     302      sn_tide_cnames(1) = 'M2'  !  name of constituent - all tidal components must be set in namelist_cfg 
     303      sn_tide_cnames(2) = 'S2' 
     304      sn_tide_cnames(3) = 'K1' 
     305      sn_tide_cnames(4) = 'O1' 
    306306/ 
    307307!----------------------------------------------------------------------- 
     
    340340   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    341341   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    342    bn_ssh      =    'bdyT_ssh_WED025'    ,         -1        , 'sossheig' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    343    bn_u2d      =    'bdyU_u2d_WED025'    ,         -1        , 'vobtcrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    344    bn_v2d      =    'bdyV_u2d_WED025'    ,         -1        , 'vobtcrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    345    bn_u3d      =    'bdyU_u3d_WED025'    ,         -1        , 'vozocrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    346    bn_v3d      =    'bdyV_u3d_WED025'    ,         -1        , 'vomecrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    347    bn_tem      =    'bdyT_tra_WED025'    ,         -1        , 'votemper' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    348    bn_sal      =    'bdyT_tra_WED025'    ,         -1        , 'vosaline' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     342   bn_ssh      =    'WED025_bdyT_ssh'    ,         -1        , 'sossheig' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     343   bn_u2d      =    'WED025_bdyU_u2d'    ,         -1        , 'vobtcrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     344   bn_v2d      =    'WED025_bdyV_u2d'    ,         -1        , 'vobtcrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     345   bn_u3d      =    'WED025_bdyU_u3d'    ,         -1        , 'vozocrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     346   bn_v3d      =    'WED025_bdyV_u3d'    ,         -1        , 'vomecrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     347   bn_tem      =    'WED025_bdyT_tra'    ,         -1        , 'votemper' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     348   bn_sal      =    'WED025_bdyT_tra'    ,         -1        , 'vosaline' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    349349!* for si3 
    350    bn_a_i      =    'bdyT_ice_WED025'    ,         -1        , 'ileadfra' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    351    bn_h_i      =    'bdyT_ice_WED025'    ,         -1        , 'iicethic' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    352    bn_h_s      =    'bdyT_ice_WED025'    ,         -1        , 'isnowthi' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     350   bn_a_i      =    'WED025_bdyT_ice'    ,         -1        , 'ileadfra' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     351   bn_h_i      =    'WED025_bdyT_ice'    ,         -1        , 'iicethic' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     352   bn_h_s      =    'WED025_bdyT_ice'    ,         -1        , 'isnowthi' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    353353/ 
    354354!----------------------------------------------------------------------- 
    355355&nambdy_tide   !  tidal forcing at open boundaries                      (default: OFF) 
    356356!----------------------------------------------------------------------- 
    357    filtide          = 'bdytide_WED025_'         !  file name root of tidal forcing files 
     357   filtide          = 'WED025_bdytide_'         !  file name root of tidal forcing files 
    358358/ 
    359359 
     
    658658&namctl        !   Control prints                                       (default: OFF) 
    659659!----------------------------------------------------------------------- 
    660    ln_ctl = .FALSE.                 ! Toggle all report printing on/off (T/F); Ignored if sn_cfctl%l_config is T 
    661      sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the following 
    662        sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings. 
    663        sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 
    664        sn_cfctl%l_oceout  = .FALSE. ! that  all areas report. 
    665        sn_cfctl%l_layout  = .FALSE. ! 
    666        sn_cfctl%l_mppout  = .FALSE. ! 
    667        sn_cfctl%l_mpptop  = .FALSE. ! 
    668        sn_cfctl%procmin   = 0       ! Minimum area number for reporting [default:0] 
    669        sn_cfctl%procmax   = 1000000 ! Maximum area number for reporting [default:1000000] 
    670        sn_cfctl%procincr  = 1       ! Increment for optional subsetting of areas [default:1] 
    671        sn_cfctl%ptimincr  = 1       ! Timestep increment for writing time step progress info 
    672    nn_print    =    0      !  level of print (0 no extra print) 
    673    nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus 
    674    nn_ictle    =    0      !  end   i indice of control sum        multi processor runs 
    675    nn_jctls    =    0      !  start j indice of control               over a subdomain) 
    676    nn_jctle    =    0      !  end   j indice of control 
    677    nn_isplt    =    1      !  number of processors in i-direction 
    678    nn_jsplt    =    1      !  number of processors in j-direction 
    679    ln_timing   = .true.    !  timing by routine write out in timing.output file 
    680    ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
     660   sn_cfctl%l_runstat = .true.    ! switches and which areas produce reports with the proc integer settings. 
     661   ln_timing   = .true.           !  timing by routine write out in timing.output file 
    681662/ 
    682663!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/cfgs/WED025/EXPREF/namelist_ice_cfg

    r11487 r13159  
    2626&namitd         !   Ice discretization 
    2727!------------------------------------------------------------------------------ 
     28   ln_cat_hfn       = .true.          !  ice categories are defined by a function following rn_himean**(-0.05) 
     29      rn_himean     =   2.0           !  expected domain-average ice thickness (m) 
     30   rn_himin         =   0.01          !  minimum ice thickness (m) used in remapping 
    2831/ 
    2932!------------------------------------------------------------------------------ 
    3033&namdyn         !   Ice dynamics 
    3134!------------------------------------------------------------------------------ 
     35   ln_landfast_L16  = .true.          !  landfast: parameterization from Lemieux 2016 
    3236/ 
    3337!------------------------------------------------------------------------------ 
     
    4246&namdyn_adv     !   Ice advection 
    4347!------------------------------------------------------------------------------ 
     48   ln_adv_Pra       = .false.         !  Advection scheme (Prather) 
     49   ln_adv_UMx       = .true.          !  Advection scheme (Ultimate-Macho) 
     50      nn_UMx        =   5             !     order of the scheme for UMx (1-5 ; 20=centered 2nd order) 
    4451/ 
    4552!------------------------------------------------------------------------------ 
     
    6269&namthd_do      !   Ice growth in open water 
    6370!------------------------------------------------------------------------------ 
     71   rn_hinew         =   0.02          !  thickness for new ice formation in open water (m), must be larger than rn_himin 
     72   ln_frazil        = .true.          !  Frazil ice parameterization (ice collection as a function of wind) 
    6473/ 
    6574!------------------------------------------------------------------------------ 
     
    7079&namthd_pnd     !   Melt ponds 
    7180!------------------------------------------------------------------------------ 
     81   ln_pnd           = .true.          !  activate melt ponds or not 
     82     ln_pnd_H12     = .true.          !  activate evolutive melt ponds (from Holland et al 2012) 
     83     ln_pnd_alb     = .true.          !  melt ponds affect albedo or not 
    7284/ 
     85 
    7386!------------------------------------------------------------------------------ 
    7487&namini         !   Ice initialization 
    7588!------------------------------------------------------------------------------ 
     89   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
     90   ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     91   ! -- for ln_iceini_file = T 
     92   sn_hti = 'WED025_init_JRA_200001.nc', -12 ,'icethic_cea',  .false.  , .true., 'yearly'  , '' , '', '' 
     93   sn_hts = 'WED025_init_JRA_200001.nc', -12 ,'icesnow_cea',  .false.  , .true., 'yearly'  , '' , '', '' 
     94   sn_ati = 'WED025_init_JRA_200001.nc', -12 ,'ice_cover'  ,  .false.  , .true., 'yearly'  , '' , '', '' 
     95   sn_smi = 'NOT USED'              , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     96   sn_tmi = 'NOT USED'              , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     97   sn_tsu = 'NOT USED'              , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     98   sn_tms = 'NOT USED'              , -12 ,'tms'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     99   !      melt ponds (be careful, sn_apd is the pond concentration (not fraction), so it differs from rn_apd) 
     100   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     101   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     102   cn_dir='./' 
    76103/ 
    77104!------------------------------------------------------------------------------ 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ABL/abl.F90

    r12749 r13159  
    6262         &      avm_abl (1:jpi,1:jpj,1:jpka            ), & 
    6363         &      avt_abl (1:jpi,1:jpj,1:jpka            ), & 
    64          &      mxld_abl(1:jpi,1:jpj,1:jpka            ), &          
    65          &      mxlm_abl(1:jpi,1:jpj,1:jpka            ), &  
     64         &      mxld_abl(1:jpi,1:jpj,1:jpka            ), & 
     65         &      mxlm_abl(1:jpi,1:jpj,1:jpka            ), & 
    6666         &      fft_abl (1:jpi,1:jpj                   ), & 
    67          &      pblh    (1:jpi,1:jpj                   ), &          
     67         &      pblh    (1:jpi,1:jpj                   ), & 
    6868         &      msk_abl (1:jpi,1:jpj                   ), & 
    69          &      rest_eq (1:jpi,1:jpj                   ), &          
     69         &      rest_eq (1:jpi,1:jpj                   ), & 
    7070         &      e3t_abl (1:jpka), e3w_abl(1:jpka)       , & 
    7171         &      ght_abl (1:jpka), ghw_abl(1:jpka)       , STAT=ierr ) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ABL/ablrst.F90

    r12770 r13159  
    7474            ENDIF 
    7575            ! 
    76             CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka ) 
     76            CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka, cdcomp = 'ABL' ) 
    7777            lrst_abl = .TRUE. 
    7878         ENDIF 
     
    146146      ENDIF 
    147147 
    148       CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar, kdlev = jpka ) 
     148      CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar ) 
    149149 
    150150      ! Time info 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ABL/sbcabl.F90

    r12808 r13159  
    335335      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    336336 
    337         !!------------------------------------------------------------------------------------------- 
    338         !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
    339         !!------------------------------------------------------------------------------------------- 
    340    
    341         CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
    342            &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
    343            &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
    344            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
    345            &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
     337         !!------------------------------------------------------------------------------------------- 
     338         !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
     339         !!------------------------------------------------------------------------------------------- 
     340 
     341         CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
     342            &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
     343            &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
     344            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
     345            &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
    346346 
    347347#if defined key_si3 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ICE/icectl.F90

    r12544 r13159  
    331331      IF(lwp) WRITE(numout,*)                 
    332332 
    333       CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
     333      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    334334       
    335335      CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ICE/iceistate.F90

    r12489 r13159  
    179179            ! 
    180180            ! -- mandatory fields -- ! 
    181             zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 
    182             zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 
    183             zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 
     181            zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
     182            zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
     183            zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
    184184 
    185185            ! -- optional fields -- ! 
     
    219219               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    220220            ! 
    221             zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 
    222             ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 
    223             zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 
    224             ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 
    225             zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 
    226             zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 
     221            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
     222            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
     223            zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
     224            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
     225            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
     226            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
    227227            ! 
    228228            ! change the switch for the following 
     
    436436!!clem: output of initial state should be written here but it is impossible because 
    437437!!      the ocean and ice are in the same file 
    438 !!      CALL dia_wri_state( 'output.init' ) 
     438!!      CALL dia_wri_state( Kmm, 'output.init' ) 
    439439      ! 
    440440   END SUBROUTINE ice_istate 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ICE/icerst.F90

    r12377 r13159  
    8080            ENDIF 
    8181            ! 
    82             CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl ) 
     82            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    8383            lrst_ice = .TRUE. 
    8484         ENDIF 
     
    185185      ENDIF 
    186186 
    187       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl ) 
     187      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 
    188188 
    189189      ! test if v_i exists  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ICE/icesbc.F90

    r12588 r13159  
    148148      CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation 
    149149                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    & 
    150             &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) ) 
     150            &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    !  
    151151         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 ) 
    152152         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/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/ASM/asminc.F90

    r12489 r13159  
    896896         IF ( kt == nitdin_r ) THEN 
    897897            ! 
    898             l_1st_euler = 0              ! Force Euler forward step 
     898            l_1st_euler = .TRUE.              ! Force Euler forward step 
    899899            ! 
    900900            ! Sea-ice : SI3 case 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/BDY/bdydta.F90

    r12547 r13159  
    9191      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices 
    9292      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers 
    93       INTEGER,   DIMENSION(jpbgrd)     ::   ilen1  
    9493      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut 
    9594      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias 
     
    116115                  END DO 
    117116               ENDIF 
    118                IF( dta_bdy(jbdy)%lneed_dyn2d) THEN  
     117               IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
    119118                  igrd = 2 
    120                   DO ib = 1, SIZE(dta_bdy(jbdy)%u2d)   ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init 
     119                  DO ib = 1, SIZE(dta_bdy(jbdy)%u2d)      ! u2d is used either over the whole bdy or only on the rim 
    121120                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    122121                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    123122                     dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1)          
    124123                  END DO 
     124               ENDIF 
     125               IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
    125126                  igrd = 3 
    126                   DO ib = 1, SIZE(dta_bdy(jbdy)%v2d)   ! v2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init 
     127                  DO ib = 1, SIZE(dta_bdy(jbdy)%v2d)      ! v2d is used either over the whole bdy or only on the rim 
    127128                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    128129                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
     
    210211         ! 
    211212         ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 
    212          IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d 
     213         IF( cn_tra(jbdy) == 'runoff' ) THEN   ! runoff 
    213214            ! 
    214             igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
    215             DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    216                ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    217                ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    218                dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    219             END DO 
    220             igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
    221             DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    222                ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    223                ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    224                dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    225             END DO 
     215            IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
     216               igrd = 2                         ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
     217               DO ib = 1, SIZE(dta_alias%u2d)   ! u2d is used either over the whole bdy or only on the rim 
     218                  ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     219                  ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     220                  dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     221               END DO 
     222            ENDIF 
     223            IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
     224               igrd = 3                         ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
     225               DO ib = 1, SIZE(dta_alias%v2d)   ! v2d is used either over the whole bdy or only on the rim 
     226                  ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     227                  ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     228                  dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     229               END DO 
     230            ENDIF 
    226231         ENDIF 
    227232 
    228233         ! tidal harmonic forcing ONLY: initialise arrays 
    229234         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d  
    230             IF( dta_alias%lneed_ssh  ) dta_alias%ssh(:) = 0._wp 
    231             IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp 
    232             IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp 
     235            IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 
     236            IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 
     237            IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 
    233238         ENDIF 
    234239 
     
    237242            ! 
    238243            igrd = 2                       ! zonal velocity 
    239             dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d 
    240244            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    241245               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    242246               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     247               dta_alias%u2d(ib) = 0._wp   ! compute barotrope zonal velocity and put it in u2d 
    243248               DO ik = 1, jpkm1 
    244249                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
     
    250255            END DO 
    251256            igrd = 3                       ! meridional velocity 
    252             dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d 
    253257            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    254258               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    255259               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     260               dta_alias%v2d(ib) = 0._wp   ! compute barotrope meridional velocity and put it in v2d 
    256261               DO ik = 1, jpkm1 
    257262                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
     
    275280 
    276281#if defined key_si3 
    277          IF( dta_alias%lneed_ice ) THEN 
     282         IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 
    278283            ! fill temperature and salinity arrays 
    279284            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) 
     
    330335            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop 
    331336               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
    332                   IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=idx_bdy(jbdy)%nblen(:) 
    333                   ELSE                                 ;   ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 
    334                   ENDIF 
    335                   IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
    336                   IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
    337                   IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
     337                  IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 
     338                  IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 
     339                  IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 
    338340               ENDIF 
    339341            END DO 
    340342         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
    341343            ! 
    342             ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step 
    343344            CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 
    344345         ENDIF 
     
    348349      ! 
    349350   END SUBROUTINE bdy_dta 
    350  
     351    
    351352 
    352353   SUBROUTINE bdy_dta_init 
     
    380381      LOGICAL                                ::   llneed        ! 
    381382      LOGICAL                                ::   llread        ! 
     383      LOGICAL                                ::   llfullbdy     ! 
    382384      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
    383385      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
     
    494496               igrd = 2                                                    ! U point 
    495497               ipk = 1                                                     ! surface data 
    496                llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     498               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%u2d will be needed 
    497499               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file 
    498500               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy 
    499501               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta 
    500                IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from u3d -> need on the full bdy 
    501                ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     502               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need u2d over the whole bdy or only over the rim? 
     503               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd) 
     504               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd) 
    502505               ENDIF 
    503506            ENDIF 
     
    506509               igrd = 3                                                    ! V point 
    507510               ipk = 1                                                     ! surface data 
    508                llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     511               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%v2d will be needed 
    509512               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file 
    510513               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy 
    511514               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta  
    512                IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from v3d -> need on the full bdy 
    513                ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     515               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need v2d over the whole bdy or only over the rim? 
     516               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd) 
     517               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd) 
    514518               ENDIF 
    515519            ENDIF 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/BDY/bdyini.F90

    r12377 r13159  
    1919   USE oce            ! ocean dynamics and tracers variables 
    2020   USE dom_oce        ! ocean space and time domain 
     21   USE sbc_oce , ONLY: nn_ice 
    2122   USE bdy_oce        ! unstructured open boundary conditions 
    2223   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine) 
    2324   USE bdytides       ! open boundary cond. setting   (bdytide_init routine) 
    2425   USE tide_mod, ONLY: ln_tide ! tidal forcing 
    25    USE phycst   , ONLY: rday 
     26   USE phycst  , ONLY: rday 
    2627   ! 
    2728   USE in_out_manager ! I/O units 
     
    315316 
    316317         dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 
     318 
     319         IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN 
     320            WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice 
     321            CALL ctl_stop( ctmp1 ) 
     322         ENDIF 
    317323 
    318324         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/BDY/bdytides.F90

    r12489 r13159  
    6565      !! namelist variables 
    6666      !!------------------- 
    67       CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files 
    68       LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data 
     67      CHARACTER(len=80)                         ::   filtide             ! Filename root for tidal input files 
     68      LOGICAL                                   ::   ln_bdytide_2ddta    ! If true, read 2d harmonic data 
    6969      !! 
    70       INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices 
    71       INTEGER                                   ::   ii, ij              !: dummy loop indices 
     70      INTEGER                                   ::   ib_bdy, itide, ib   ! dummy loop indices 
     71      INTEGER                                   ::   ii, ij              ! dummy loop indices 
    7272      INTEGER                                   ::   inum, igrd 
    73       INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays) 
     73      INTEGER                                   ::   isz                 ! bdy data size 
    7474      INTEGER                                   ::   ios                 ! Local integer output status for namelist read 
    7575      INTEGER                                   ::   nbdy_rdstart, nbdy_loc 
    76       CHARACTER(LEN=50)                         ::   cerrmsg             !: error string 
    77       CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file  
    78       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data 
    79       REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !:  "     "    "   "   "   "        "      "  
     76      CHARACTER(LEN=50)                         ::   cerrmsg             ! error string 
     77      CHARACTER(len=80)                         ::   clfile              ! full file name for tidal input file  
     78      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            ! work space to read in tidal harmonics data 
     79      REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !  "     "    "   "   "   "        "      "  
    8080      !! 
    81       TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut    
     81      TYPE(TIDES_DATA), POINTER                 ::   td                  ! local short cut    
     82      TYPE(  OBC_DATA), POINTER                 ::   dta                 ! local short cut 
    8283      !! 
    8384      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta 
     
    9394         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
    9495            ! 
    95             td => tides(ib_bdy) 
    96  
     96            td  => tides(ib_bdy) 
     97            dta => dta_bdy(ib_bdy) 
     98          
    9799            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
    98100            filtide(:) = '' 
     
    130132            IF(lwp) WRITE(numout,*) ' ' 
    131133 
    132             ! Allocate space for tidal harmonics data - get size from OBC data arrays 
     134            ! Allocate space for tidal harmonics data - get size from BDY data arrays 
     135            ! Allocate also slow varying data in the case of time splitting: 
     136            ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
    133137            ! ----------------------------------------------------------------------- 
    134  
    135             ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    136             ! relaxation area       
    137             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = idx_bdy(ib_bdy)%nblen   (:) 
    138             ELSE                                   ;   ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 
    139             ENDIF 
    140  
    141             ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 
    142             ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 
    143  
    144             ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 
    145             ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 
    146  
    147             ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 
    148             ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 
    149  
    150             td%ssh0(:,:,:) = 0._wp 
    151             td%ssh (:,:,:) = 0._wp 
    152             td%u0  (:,:,:) = 0._wp 
    153             td%u   (:,:,:) = 0._wp 
    154             td%v0  (:,:,:) = 0._wp 
    155             td%v   (:,:,:) = 0._wp 
    156  
     138            IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     139               isz = SIZE(dta%ssh) 
     140               ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 
     141               dta_bdy_s(ib_bdy)%ssh(:) = 0._wp   ! needed? 
     142            ENDIF 
     143            IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     144               isz = SIZE(dta%u2d) 
     145               ALLOCATE( td%u0  ( isz, nb_harmo, 2 ), td%u  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 
     146               dta_bdy_s(ib_bdy)%u2d(:) = 0._wp   ! needed? 
     147            ENDIF 
     148            IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     149               isz = SIZE(dta%v2d) 
     150               ALLOCATE( td%v0  ( isz, nb_harmo, 2 ), td%v  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 
     151               dta_bdy_s(ib_bdy)%v2d(:) = 0._wp   ! needed? 
     152            ENDIF 
     153 
     154            ! fill td%ssh0, td%u0, td%v0 
     155            ! ----------------------------------------------------------------------- 
    157156            IF( ln_bdytide_2ddta ) THEN 
     157               ! 
    158158               ! It is assumed that each data file contains all complex harmonic amplitudes 
    159159               ! given on the global domain (ie global, jpiglo x jpjglo) 
     
    162162               ! 
    163163               ! SSH fields 
    164                clfile = TRIM(filtide)//'_grid_T.nc' 
    165                CALL iom_open( clfile , inum )  
    166                igrd = 1                       ! Everything is at T-points here 
    167                DO itide = 1, nb_harmo 
    168                   CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
    169                   CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    170                   DO ib = 1, ilen0(igrd) 
    171                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    172                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    173                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    174                      td%ssh0(ib,itide,1) = ztr(ii,ij) 
    175                      td%ssh0(ib,itide,2) = zti(ii,ij) 
    176                   END DO 
    177                END DO  
    178                CALL iom_close( inum ) 
     164               IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     165                  clfile = TRIM(filtide)//'_grid_T.nc' 
     166                  CALL iom_open( clfile , inum )  
     167                  igrd = 1                       ! Everything is at T-points here 
     168                  DO itide = 1, nb_harmo 
     169                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     170                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
     171                     DO ib = 1, SIZE(dta%ssh) 
     172                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     173                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     174                        td%ssh0(ib,itide,1) = ztr(ii,ij) 
     175                        td%ssh0(ib,itide,2) = zti(ii,ij) 
     176                     END DO 
     177                  END DO 
     178                  CALL iom_close( inum ) 
     179               ENDIF 
    179180               ! 
    180181               ! U fields 
    181                clfile = TRIM(filtide)//'_grid_U.nc' 
    182                CALL iom_open( clfile , inum )  
    183                igrd = 2                       ! Everything is at U-points here 
    184                DO itide = 1, nb_harmo 
    185                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
    186                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
    187                   DO ib = 1, ilen0(igrd) 
    188                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    189                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    190                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    191                      td%u0(ib,itide,1) = ztr(ii,ij) 
    192                      td%u0(ib,itide,2) = zti(ii,ij) 
    193                   END DO 
    194                END DO 
    195                CALL iom_close( inum ) 
     182               IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     183                  clfile = TRIM(filtide)//'_grid_U.nc' 
     184                  CALL iom_open( clfile , inum )  
     185                  igrd = 2                       ! Everything is at U-points here 
     186                  DO itide = 1, nb_harmo 
     187                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
     188                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
     189                     DO ib = 1, SIZE(dta%u2d) 
     190                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     191                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     192                        td%u0(ib,itide,1) = ztr(ii,ij) 
     193                        td%u0(ib,itide,2) = zti(ii,ij) 
     194                     END DO 
     195                  END DO 
     196                  CALL iom_close( inum ) 
     197               ENDIF 
    196198               ! 
    197199               ! V fields 
    198                clfile = TRIM(filtide)//'_grid_V.nc' 
    199                CALL iom_open( clfile , inum )  
    200                igrd = 3                       ! Everything is at V-points here 
    201                DO itide = 1, nb_harmo 
    202                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
    203                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
    204                   DO ib = 1, ilen0(igrd) 
    205                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    206                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    207                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    208                      td%v0(ib,itide,1) = ztr(ii,ij) 
    209                      td%v0(ib,itide,2) = zti(ii,ij) 
    210                   END DO 
    211                END DO   
    212                CALL iom_close( inum ) 
     200               IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     201                  clfile = TRIM(filtide)//'_grid_V.nc' 
     202                  CALL iom_open( clfile , inum )  
     203                  igrd = 3                       ! Everything is at V-points here 
     204                  DO itide = 1, nb_harmo 
     205                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
     206                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
     207                     DO ib = 1, SIZE(dta%v2d) 
     208                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     209                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     210                        td%v0(ib,itide,1) = ztr(ii,ij) 
     211                        td%v0(ib,itide,2) = zti(ii,ij) 
     212                     END DO 
     213                  END DO 
     214                  CALL iom_close( inum ) 
     215               ENDIF 
    213216               ! 
    214217               DEALLOCATE( ztr, zti )  
     
    218221               ! Read tidal data only on bdy segments 
    219222               !  
    220                ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) ) 
     223               ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 
    221224               ! 
    222225               ! Open files and read in tidal forcing data 
     
    225228               DO itide = 1, nb_harmo 
    226229                  !                                                              ! SSH fields 
    227                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
    228                   CALL iom_open( clfile, inum ) 
    229                   CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    230                   td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 
    231                   CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    232                   td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 
    233                   CALL iom_close( inum ) 
     230                  IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     231                     isz = SIZE(dta%ssh) 
     232                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
     233                     CALL iom_open( clfile, inum ) 
     234                     CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     235                     td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 
     236                     CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     237                     td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 
     238                     CALL iom_close( inum ) 
     239                  ENDIF 
    234240                  !                                                              ! U fields 
    235                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
    236                   CALL iom_open( clfile, inum ) 
    237                   CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    238                   td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 
    239                   CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    240                   td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 
    241                   CALL iom_close( inum ) 
     241                  IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     242                     isz = SIZE(dta%u2d) 
     243                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
     244                     CALL iom_open( clfile, inum ) 
     245                     CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     246                     td%u0(:,itide,1) = dta_read(1:isz,1,1) 
     247                     CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     248                     td%u0(:,itide,2) = dta_read(1:isz,1,1) 
     249                     CALL iom_close( inum ) 
     250                  ENDIF 
    242251                  !                                                              ! V fields 
    243                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
    244                   CALL iom_open( clfile, inum ) 
    245                   CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    246                   td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 
    247                   CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    248                   td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 
    249                   CALL iom_close( inum ) 
     252                  IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     253                     isz = SIZE(dta%v2d) 
     254                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
     255                     CALL iom_open( clfile, inum ) 
     256                     CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     257                     td%v0(:,itide,1) = dta_read(1:isz,1,1) 
     258                     CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     259                     td%v0(:,itide,2) = dta_read(1:isz,1,1) 
     260                     CALL iom_close( inum ) 
     261                  ENDIF 
    250262                  ! 
    251263               END DO ! end loop on tidal components 
     
    254266               ! 
    255267            ENDIF ! ln_bdytide_2ddta=.true. 
    256             ! 
    257             ! Allocate slow varying data in the case of time splitting: 
    258             ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
    259             ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
    260             ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
    261             ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
    262             dta_bdy_s(ib_bdy)%ssh(:) = 0._wp 
    263             dta_bdy_s(ib_bdy)%u2d(:) = 0._wp 
    264             dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    265268            ! 
    266269         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 
     
    283286      ! 
    284287      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
    285       INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
    286       INTEGER, DIMENSION(jpbgrd)   ::   ilen0  
    287       INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
     288      INTEGER  ::   itide, ib_bdy, ib         ! loop indices 
    288289      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset    
    289290      !!---------------------------------------------------------------------- 
     
    310311         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
    311312            ! 
    312             nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    313             nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    314             ! 
    315             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
    316             ELSE                                   ;   ilen0(:) = nblenrim(:) 
    317             ENDIF      
    318             ! 
    319313            ! We refresh nodal factors every day below 
    320314            ! This should be done somewhere else 
     
    337331            ! If time splitting, initialize arrays from slow varying open boundary data: 
    338332            IF ( PRESENT(kit) ) THEN            
    339                IF ( dta_bdy(ib_bdy)%lneed_ssh   ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    340                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    341                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
     333               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 
     334               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 
     335               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 
    342336            ENDIF 
    343337            ! 
     
    349343               z_sist = zramp * SIN( z_sarg ) 
    350344               ! 
    351                IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 
    352                   igrd=1                              ! SSH on tracer grid 
    353                   DO ib = 1, ilen0(igrd) 
     345               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN   ! SSH on tracer grid 
     346                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 
    354347                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
    355348                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
     
    358351               ENDIF 
    359352               ! 
    360                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 
    361                   igrd=2                              ! U grid 
    362                   DO ib = 1, ilen0(igrd) 
     353               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN  ! U grid 
     354                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 
    363355                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
    364356                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
    365357                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
    366358                  END DO 
    367                   igrd=3                              ! V grid 
    368                   DO ib = 1, ilen0(igrd)  
     359               ENDIF 
     360               ! 
     361               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN   ! V grid 
     362                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 
    369363                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
    370364                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
     
    372366                  END DO 
    373367               ENDIF 
     368               ! 
    374369            END DO              
    375          END IF 
     370         ENDIF 
    376371      END DO 
    377372      ! 
     
    386381      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
    387382      ! 
    388       INTEGER ::   itide, igrd, ib       ! dummy loop indices 
    389       INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays) 
     383      INTEGER ::   itide, isz, ib       ! dummy loop indices 
    390384      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    391385      !!---------------------------------------------------------------------- 
    392386      ! 
    393       igrd=1    
    394                               ! SSH on tracer grid. 
    395       ilen0(1) =  SIZE(td%ssh0(:,1,1)) 
    396       ! 
    397       ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 
    398       ! 
    399       DO itide = 1, nb_harmo 
    400          DO ib = 1, ilen0(igrd) 
    401             mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 
    402             phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 
     387      IF( ASSOCIATED(td%ssh0) ) THEN   ! SSH on tracer grid. 
     388         ! 
     389         isz = SIZE( td%ssh0, dim = 1 ) 
     390         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     391         ! 
     392         DO itide = 1, nb_harmo 
     393            DO ib = 1, isz 
     394               mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 
     395               phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 
     396            END DO 
     397            DO ib = 1, isz 
     398               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     399               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
     400            END DO 
     401            DO ib = 1, isz 
     402               td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     403               td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     404            END DO 
    403405         END DO 
    404          DO ib = 1 , ilen0(igrd) 
    405             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    406             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
    407          ENDDO 
    408          DO ib = 1 , ilen0(igrd) 
    409             td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    410             td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    411          ENDDO 
    412       END DO 
    413       ! 
    414       DEALLOCATE( mod_tide, phi_tide ) 
     406         ! 
     407         DEALLOCATE( mod_tide, phi_tide ) 
     408         ! 
     409      ENDIF 
    415410      ! 
    416411   END SUBROUTINE tide_init_elevation 
     
    424419      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
    425420      ! 
    426       INTEGER ::   itide, igrd, ib       ! dummy loop indices 
    427       INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays) 
     421      INTEGER ::   itide, isz, ib        ! dummy loop indices 
    428422      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    429423      !!---------------------------------------------------------------------- 
    430424      ! 
    431       ilen0(2) =  SIZE(td%u0(:,1,1)) 
    432       ilen0(3) =  SIZE(td%v0(:,1,1)) 
    433       ! 
    434       igrd=2                                 ! U grid. 
    435       ! 
    436       ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    437       ! 
    438       DO itide = 1, nb_harmo 
    439          DO ib = 1, ilen0(igrd) 
    440             mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 
    441             phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 
     425      IF( ASSOCIATED(td%u0) ) THEN   ! U grid. we use bdy u2d on this mpi subdomain 
     426         ! 
     427         isz = SIZE( td%u0, dim = 1 ) 
     428         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     429         ! 
     430         DO itide = 1, nb_harmo 
     431            DO ib = 1, isz 
     432               mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 
     433               phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 
     434            END DO 
     435            DO ib = 1, isz 
     436               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     437               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
     438            END DO 
     439            DO ib = 1, isz 
     440               td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     441               td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     442            END DO 
    442443         END DO 
    443          DO ib = 1, ilen0(igrd) 
    444             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    445             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    446          ENDDO 
    447          DO ib = 1, ilen0(igrd) 
    448             td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    449             td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    450          ENDDO 
    451       END DO 
    452       ! 
    453       DEALLOCATE( mod_tide , phi_tide ) 
    454       ! 
    455       igrd=3                                 ! V grid. 
    456       ! 
    457       ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    458  
    459       DO itide = 1, nb_harmo 
    460          DO ib = 1, ilen0(igrd) 
    461             mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 
    462             phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 
     444         ! 
     445         DEALLOCATE( mod_tide, phi_tide ) 
     446         ! 
     447      ENDIF 
     448      ! 
     449      IF( ASSOCIATED(td%v0) ) THEN   ! V grid. we use bdy u2d on this mpi subdomain 
     450         ! 
     451         isz = SIZE( td%v0, dim = 1 ) 
     452         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     453         ! 
     454         DO itide = 1, nb_harmo 
     455            DO ib = 1, isz 
     456               mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 
     457               phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 
     458            END DO 
     459            DO ib = 1, isz 
     460               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     461               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
     462            END DO 
     463            DO ib = 1, isz 
     464               td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     465               td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     466            END DO 
    463467         END DO 
    464          DO ib = 1, ilen0(igrd) 
    465             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    466             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    467          ENDDO 
    468          DO ib = 1, ilen0(igrd) 
    469             td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    470             td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    471          ENDDO 
    472       END DO 
    473       ! 
    474       DEALLOCATE( mod_tide, phi_tide ) 
    475       ! 
    476   END SUBROUTINE tide_init_velocities 
     468         ! 
     469         DEALLOCATE( mod_tide, phi_tide ) 
     470         ! 
     471      ENDIF 
     472      ! 
     473   END SUBROUTINE tide_init_velocities 
    477474 
    478475   !!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/C1D/step_c1d.F90

    r12377 r13159  
    2727   PRIVATE 
    2828 
    29    PUBLIC stp_c1d      ! called by opa.F90 
     29   PUBLIC stp_c1d      ! called by nemogcm.F90 
    3030 
    3131   !!---------------------------------------------------------------------- 
     
    5656      ! 
    5757      INTEGER ::   jk       ! dummy loop indice 
    58       INTEGER ::   indic    ! error indicator if < 0 
    5958      !! --------------------------------------------------------------------- 
    60  
    61                              indic = 0                ! reset to no error condition 
    6259      IF( kstp == nit000 )   CALL iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    6360      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
     
    8885      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8986                         CALL dia_wri( kstp, Nnn )  ! ocean model: outputs 
    90       IF( lk_diahth  )   CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
     87                         CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
    9188 
    9289 
     
    111108                        CALL eos( ts(:,:,:,:,Nnn), rhd, rhop, gdept_0(:,:,:) )  ! now potential density for zdfmxl 
    112109      IF( ln_zdfnpc )   CALL tra_npc( kstp,      Nnn, Nrhs, ts, Naa   )         ! applied non penetrative convective adjustment on (t,s) 
    113                         CALL tra_atf( kstp, Nbb, Nnn, Nrhs,     Naa, ts   )     ! time filtering of "now" tracer fields 
    114  
    115  
     110                        CALL tra_atf( kstp, Nbb, Nnn, Naa, ts )                 ! time filtering of "now" tracer arrays 
    116111 
    117112      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    139134      ! Control and restarts 
    140135      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    141                              CALL stp_ctl( kstp, Nnn, indic ) 
     136                             CALL stp_ctl( kstp, Nnn ) 
    142137      IF( kstp == nit000 )   CALL iom_close( numror )          ! close input  ocean restart file 
    143138      IF( lrst_oce       )   CALL rst_write( kstp, Nbb, Nnn )  ! write output ocean restart file 
    144139      ! 
    145140#if defined key_iomput 
    146       IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS 
     141      IF( kstp == nitend .OR. nstop > 0 )   CALL xios_context_finalize()   ! needed for XIOS 
    147142      ! 
    148143#endif 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DIA/diaar5.F90

    r12489 r13159  
    3232   REAL(wp)                         ::   vol0         ! ocean volume (interior domain) 
    3333   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain) 
    34    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain) 
    3534   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    3635   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
     
    5453      !!---------------------------------------------------------------------- 
    5554      ! 
    56       ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     55      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
    5756      ! 
    5857      CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 
     
    7877      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    7978      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe, z2d                   ! 2D workspace  
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop, ztpot   ! 3D workspace 
     79      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , ztpot               ! 3D workspace 
    8180      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8281 
     
    8887      IF( l_ar5 ) THEN  
    8988         ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 
    90          ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
     89         ALLOCATE( zrhd(jpi,jpj,jpk) ) 
    9190         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    92          zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm) 
    93       ENDIF 
    94       ! 
    95       CALL iom_put( 'e2u'      , e2u (:,:) ) 
    96       CALL iom_put( 'e1v'      , e1v (:,:) ) 
    97       CALL iom_put( 'areacello', area(:,:) ) 
     91         zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 
     92      ENDIF 
     93      ! 
     94      CALL iom_put( 'e2u'      , e2u  (:,:) ) 
     95      CALL iom_put( 'e1v'      , e1v  (:,:) ) 
     96      CALL iom_put( 'areacello', e1e2t(:,:) ) 
    9897      ! 
    9998      IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' )  ) THEN   
    10099         zrhd(:,:,jpk) = 0._wp        ! ocean volume ; rhd is used as workspace 
    101100         DO jk = 1, jpkm1 
    102             zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     101            zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    103102         END DO 
    104103         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 
     
    151150         END IF 
    152151         !                                          
    153          zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )  
     152         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
    154153         zssh_steric = - zarho / area_tot 
    155154         CALL iom_put( 'sshthster', zssh_steric ) 
    156155       
    157156         !                                         ! steric sea surface height 
    158          CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density 
    159          zrhop(:,:,jpk) = 0._wp 
    160          CALL iom_put( 'rhop', zrhop ) 
    161          ! 
    162157         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    163158         DO jk = 1, jpkm1 
    164             zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
     159            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 
    165160         END DO 
    166161         IF( ln_linssh ) THEN 
     
    169164                  DO jj = 1,jpj 
    170165                     iks = mikt(ji,jj) 
    171                      zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 
     166                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 
    172167                  END DO 
    173168               END DO 
    174169            ELSE 
    175                zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
     170               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 
    176171            END IF 
    177172         END IF 
    178173         !     
    179          zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )  
     174         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
    180175         zssh_steric = - zarho / area_tot 
    181176         CALL iom_put( 'sshsteric', zssh_steric ) 
     
    191186          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 
    192187          DO_3D_11_11( 1, jpkm1 ) 
    193              zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
     188             zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    194189             ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
    195190             ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
     
    237232               z2d(:,:) = 0._wp 
    238233               DO jk = 1, jpkm1 
    239                  z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
     234                 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
    240235               END DO 
    241236               ztemp = glob_sum( 'diaar5', z2d(:,:)  )  
     
    244239             ! 
    245240             IF( iom_use( 'ssttot' ) ) THEN   ! Output potential temperature in case we use TEOS-10 
    246                zsst = glob_sum( 'diaar5',  area(:,:) * ztpot(:,:,1)  )  
     241               zsst = glob_sum( 'diaar5',  e1e2t(:,:) * ztpot(:,:,1)  )  
    247242               CALL iom_put( 'ssttot', zsst / area_tot ) 
    248243             ENDIF 
     
    259254      ELSE        
    260255         IF( iom_use('ssttot') ) THEN   ! Output sst in case we use EOS-80 
    261             zsst  = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
     256            zsst  = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
    262257            CALL iom_put('ssttot', zsst / area_tot ) 
    263258         ENDIF 
     
    294289      IF( l_ar5 ) THEN 
    295290        DEALLOCATE( zarea_ssh , zbotpres, z2d ) 
    296         DEALLOCATE( zrhd      , zrhop    ) 
    297291        DEALLOCATE( ztsn                 ) 
    298292      ENDIF 
     
    368362      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
    369363         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
    370          &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE. 
     364         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
     365         &  iom_use( 'rhop' )  ) L_ar5 = .TRUE. 
    371366   
    372367      IF( l_ar5 ) THEN 
     
    375370         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    376371 
    377          area(:,:) = e1e2t(:,:) 
    378          area_tot  = glob_sum( 'diaar5', area(:,:) ) 
     372         area_tot  = glob_sum( 'diaar5', e1e2t(:,:) ) 
    379373 
    380374         ALLOCATE( zvol0(jpi,jpj) ) 
     
    383377         DO_3D_11_11( 1, jpkm1 ) 
    384378            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    385             zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
     379            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * e1e2t(ji,jj) 
    386380            thick0(ji,jj) = thick0(ji,jj) +  idep     
    387381         END_3D 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DIA/diamlr.F90

    r12377 r13159  
    8484      INTEGER                                     ::   itide                       ! Number of available tidal components 
    8585      REAL(wp)                                    ::   ztide_phase                 ! Tidal-constituent phase at adatrj=0 
    86       CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = ' n/a ' 
     86      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = 'n/a ' 
    8787      TYPE(tide_harmonic), DIMENSION(:), POINTER  ::   stideconst 
    8888 
     
    145145            ! Retrieve information (frequency, phase, nodal correction) about all 
    146146            ! available tidal constituents for placeholder substitution below 
    147             ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf',    & 
    148                &                      'Msqm', 'Sa', 'K1', 'O1', 'P1',     & 
    149                &                      'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 
    150                &                      'K2', 'nu2', 'mu2', '2N2', 'L2',    & 
    151                &                      'T2', 'eps2', 'lam2', 'R2', 'M3',   & 
    152                &                      'MKS2', 'MN4', 'MS4', 'M4', 'N4',   & 
    153                &                      'S4', 'M6', 'M8' /) 
     147            ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
     148            ctide_selected(1:34) = (/ 'Mf  ', 'Mm  ', 'Ssa ', 'Mtm ', 'Msf ',         & 
     149               &                      'Msqm', 'Sa  ', 'K1  ', 'O1  ', 'P1  ',         & 
     150               &                      'Q1  ', 'J1  ', 'S1  ', 'M2  ', 'S2  ', 'N2  ', & 
     151               &                      'K2  ', 'nu2 ', 'mu2 ', '2N2 ', 'L2  ',         & 
     152               &                      'T2  ', 'eps2', 'lam2', 'R2  ', 'M3  ',         & 
     153               &                      'MKS2', 'MN4 ', 'MS4 ', 'M4  ', 'N4  ',         & 
     154               &                      'S4  ', 'M6  ', 'M8  ' /) 
    154155            CALL tide_init_harmonics(ctide_selected, stideconst) 
    155156            itide = size(stideconst) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DIA/diawri.F90

    r12493 r13159  
    171171         CALL iom_put( "sbs", z2d )                ! bottom salinity 
    172172      ENDIF 
     173 
     174      CALL iom_put( "rhop", rhop(:,:,:) )          ! 3D potential density (sigma0) 
    173175 
    174176      IF ( iom_use("taubot") ) THEN                ! bottom stress 
     
    924926      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    925927      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    926  
    927 #if defined key_si3 
    928      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    929 #else 
    930      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    931 #endif 
    932  
     928      ! 
     929      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     930      ! 
    933931      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature 
    934932      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity 
     
    943941      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity 
    944942      CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height 
    945  
     943      ! 
    946944      IF ( ln_isf ) THEN 
    947945         IF (ln_isfcav_mlt) THEN 
     
    949947            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity 
    950948            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity 
    951             CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,8)    )    ! now k-velocity 
    952             CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,8)    )    ! now k-velocity 
    953             CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,8), ktype = jp_i1 ) 
     949            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity 
     950            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity 
     951            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 
    954952         END IF 
    955953         IF (ln_isfpar_mlt) THEN 
    956             CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,8) )    ! now k-velocity 
     954            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity 
    957955            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity 
    958956            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity 
    959957            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity 
    960             CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,8)    )    ! now k-velocity 
    961             CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,8)    )    ! now k-velocity 
    962             CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,8), ktype = jp_i1 ) 
     958            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity 
     959            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity 
     960            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 
    963961         END IF 
    964962      END IF 
    965  
     963      ! 
    966964      IF( ALLOCATED(ahtu) ) THEN 
    967965         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
     
    993991         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
    994992      ENDIF 
    995   
     993      ! 
     994      CALL iom_close( inum ) 
     995      !  
    996996#if defined key_si3 
    997997      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     998         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    998999         CALL ice_wri_state( inum ) 
    999       ENDIF 
     1000         CALL iom_close( inum ) 
     1001      ENDIF 
     1002      ! 
    10001003#endif 
    1001       ! 
    1002       CALL iom_close( inum ) 
    1003       !  
    10041004   END SUBROUTINE dia_wri_state 
    10051005 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DOM/dom_oce.F90

    r12489 r13159  
    1717   !!---------------------------------------------------------------------- 
    1818   !!   Agrif_Root    : dummy function used when lk_agrif=F 
     19   !!   Agrif_Fixed   : dummy function used when lk_agrif=F 
    1920   !!   Agrif_CFixed  : dummy function used when lk_agrif=F 
    2021   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays 
     
    233234   END FUNCTION Agrif_Root 
    234235 
     236   INTEGER FUNCTION Agrif_Fixed() 
     237      Agrif_Fixed = 0 
     238   END FUNCTION Agrif_Fixed 
     239 
    235240   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    236241      Agrif_CFixed = '0'  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DOM/dommsk.F90

    r12377 r13159  
    259259               ENDIF 
    260260            END DO 
    261 #if defined key_agrif  
    262             IF( .NOT. AGRIF_Root() ) THEN  
    263                IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east  
    264                IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west  
    265                IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north  
    266                IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south  
    267             ENDIF  
    268 #endif  
    269261         END DO 
    270262         ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DOM/domvvl.F90

    r12489 r13159  
    903903               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    904904 
    905                DO ji = 1, jpi 
    906                   DO jj = 1, jpj 
    907                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    908                        CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    909                      ENDIF 
    910                   END DO  
    911                END DO  
     905               DO_2D_11_11 
     906                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
     907                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
     908                  ENDIF 
     909               END_2D 
    912910               ! 
    913911            ELSE 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DOM/istate.F90

    r12489 r13159  
    2424   USE dom_oce        ! ocean space and time domain  
    2525   USE daymod         ! calendar 
    26    USE divhor         ! horizontal divergence            (div_hor routine) 
    2726   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
    2827   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
     
    121120         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    122121         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    123          hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    124          CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
    125 !!gm                                    hdiv(:,:,:) = 0._wp 
    126122 
    127123!!gm POTENTIAL BUG : 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DYN/divhor.F90

    r12377 r13159  
    8484      END_3D 
    8585      ! 
    86 #if defined key_agrif 
    87       IF( .NOT. Agrif_Root() ) THEN 
    88          IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west 
    89          IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east 
    90          IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south 
    91          IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north 
    92       ENDIF 
    93 #endif 
    94       ! 
    9586      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field) 
    9687      ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DYN/dynldf_lap_blp.F90

    r12377 r13159  
    7474         DO_2D_01_01 
    7575            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    76 !!gm open question here : e3f  at before or now ?    probably now... 
    77 !!gm note that ahmf has already been multiplied by fmask 
    78             zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       & 
     76            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    7977               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    8078               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
    8179            !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    82 !!gm note that ahmt has already been multiplied by tmask 
    83             zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)                                         & 
     80            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
    8481               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
    8582               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
     
    8784         ! 
    8885         DO_2D_00_00 
    89             pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                                                 & 
     86            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    9087               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    91                &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
     88               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
    9289               ! 
    93             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * (                                                 & 
     90            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
    9491               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
    95                &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
     92               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
    9693         END_2D 
    9794         !                                             ! =============== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DYN/dynvor.F90

    r12377 r13159  
    810810         DO_3D_10_10( 1, jpk ) 
    811811            IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              & 
    812                & + tmask(ji,jj  ,jk) + tmask(ji+1,jj+1,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp 
     812               & + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp 
    813813         END_3D 
    814814         ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DYN/sshwzv.F90

    r12489 r13159  
    202202#if defined key_agrif  
    203203      IF( .NOT. AGRIF_Root() ) THEN  
    204          IF ((nbondi ==  1).OR.(nbondi == 2)) pww(nlci-1 , :     ,:) = 0.e0      ! east  
    205          IF ((nbondi == -1).OR.(nbondi == 2)) pww(2      , :     ,:) = 0.e0      ! west  
    206          IF ((nbondj ==  1).OR.(nbondj == 2)) pww(:      ,nlcj-1 ,:) = 0.e0      ! north  
    207          IF ((nbondj == -1).OR.(nbondj == 2)) pww(:      ,2      ,:) = 0.e0      ! south  
     204         ! Mask vertical velocity at first/last columns/row  
     205         ! inside computational domain (cosmetic)  
     206         ! --- West --- ! 
     207         DO ji = mi0(2), mi1(2) 
     208            DO jj = 1, jpj 
     209               pww(ji,jj,:) = 0._wp  
     210            ENDDO 
     211         ENDDO 
     212         ! 
     213         ! --- East --- ! 
     214         DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 
     215            DO jj = 1, jpj 
     216               pww(ji,jj,:) = 0._wp 
     217            ENDDO 
     218         ENDDO 
     219         ! 
     220         ! --- South --- ! 
     221         DO jj = mj0(2), mj1(2) 
     222            DO ji = 1, jpi 
     223               pww(ji,jj,:) = 0._wp 
     224            ENDDO 
     225         ENDDO 
     226         ! 
     227         ! --- North --- ! 
     228         DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 
     229            DO ji = 1, jpi 
     230               pww(ji,jj,:) = 0._wp 
     231            ENDDO 
     232         ENDDO 
    208233      ENDIF  
    209234#endif  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/FLO/floblk.F90

    r12489 r13159  
    175175            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 
    176176            IF( zufl(jfl)*zuoutfl <= 0. ) THEN 
    177                ztxfl(jfl) = 1.E99 
     177               ztxfl(jfl) = HUGE(1._wp) 
    178178            ELSE 
    179179               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
     
    191191            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 
    192192            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 
    193                ztyfl(jfl) = 1.E99 
     193               ztyfl(jfl) = HUGE(1._wp) 
    194194            ELSE 
    195195               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
     
    208208               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 
    209209               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 
    210                   ztzfl(jfl) = 1.E99 
     210                  ztzfl(jfl) = HUGE(1._wp) 
    211211               ELSE 
    212212                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/ICB/icbrst.F90

    r12472 r13159  
    188188      ! 
    189189      INTEGER ::   jn   ! dummy loop index 
     190      INTEGER ::   idg  ! number of digits 
    190191      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    191192      CHARACTER(len=256)     :: cl_path 
    192193      CHARACTER(len=256)     :: cl_filename 
    193       CHARACTER(len=256)     :: cl_kt 
     194      CHARACTER(len=8  )     :: cl_kt 
     195      CHARACTER(LEN=12 )     :: clfmt            ! writing format 
    194196      TYPE(iceberg), POINTER :: this 
    195197      TYPE(point)  , POINTER :: pt 
     
    211213         ! file name 
    212214         WRITE(cl_kt, '(i8.8)') kt 
    213          cl_filename = TRIM(cexper)//"_"//TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out) 
     215         cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out) 
    214216         IF( lk_mpp ) THEN 
    215             WRITE(cl_filename,'(A,"_",I4.4,".nc")') TRIM(cl_filename), narea-1 
     217            idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     218            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     219            WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
    216220         ELSE 
    217             WRITE(cl_filename,'(A,".nc")') TRIM(cl_filename) 
     221            WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    218222         ENDIF 
    219223 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/ICB/icbtrj.F90

    r12489 r13159  
    6262      ! 
    6363      INTEGER                ::   iret, iyear, imonth, iday 
     64      INTEGER                ::   idg  ! number of digits 
    6465      REAL(wp)               ::   zfjulday, zsec 
    6566      CHARACTER(len=80)      ::   cl_filename 
    66       CHARACTER(LEN=20)      ::   cldate_ini, cldate_end 
     67      CHARACTER(LEN=12)      ::   clfmt            ! writing format 
     68      CHARACTER(LEN=8 )      ::   cldate_ini, cldate_end 
    6769      TYPE(iceberg), POINTER ::   this 
    6870      TYPE(point)  , POINTER ::   pt 
     
    8082 
    8183      ! define trajectory output name 
    82       IF ( lk_mpp ) THEN   ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")')   & 
    83          &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1 
    84       ELSE                 ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A         ,".nc")')   & 
    85          &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)) 
     84      cl_filename = 'trajectory_icebergs_'//cldate_ini//'-'//cldate_end 
     85      IF ( lk_mpp ) THEN 
     86         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     87         WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     88         WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
     89      ELSE 
     90         WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    8691      ENDIF 
    8792      IF( lwp .AND. nn_verbose_level >= 0 )   WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/IOM/in_out_manager.F90

    r12377 r13159  
    100100   !!---------------------------------------------------------------------- 
    101101   TYPE :: sn_ctl                !: structure for control over output selection 
    102       LOGICAL :: l_glochk  = .FALSE.  !: range sanity checks are local (F) or global (T) 
    103                                       !  Use global setting for debugging only; 
    104                                       !  local breaches will still be reported 
    105                                       !  and stop the code in most cases. 
    106       LOGICAL :: l_allon   = .FALSE.  !: overall control; activate all following output options 
    107       LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control 
    108                                       !  Note if l_config is True then sn_cfctl%l_allon is ignored. 
    109                                       !  Otherwise setting sn_cfctl%l_allon T/F is equivalent to  
    110                                       !  setting all the following logicals in this structure T/F 
    111                                       !  and disabling subsetting of processors 
    112102      LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F) 
    113103      LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F) 
     
    169159   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 
    170160   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run) 
     161!$AGRIF_DO_NOT_TREAT 
     162   INTEGER       ::   ngrdstop = -1         !: grid number having nstop > 1 
     163!$AGRIF_END_DO_NOT_TREAT 
    171164   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run) 
    172165   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/IOM/iom.F90

    r12799 r13159  
    111111      CHARACTER(len=lc) :: clname 
    112112      INTEGER             :: irefyear, irefmonth, irefday 
    113       INTEGER           :: ji, jkmin 
     113      INTEGER           :: ji 
    114114      LOGICAL :: llrst_context              ! is context related to restart 
    115115      ! 
     
    220220           
    221221          ! Add vertical grid bounds 
    222           jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    223           zt_bnds(2,:        ) = gdept_1d(:) 
    224           zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 
    225           zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1) 
    226           zw_bnds(1,:        ) = gdepw_1d(:) 
    227           zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    228           zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     222          zt_bnds(2,:      ) = gdept_1d(:) 
     223          zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1) 
     224          zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1) 
     225          zw_bnds(1,:      ) = gdepw_1d(:) 
     226          zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     227          zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    229228          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
    230229          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
     
    665664 
    666665 
    667    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 
     666   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 
    668667      !!--------------------------------------------------------------------- 
    669668      !!                   ***  SUBROUTINE  iom_open  *** 
     
    678677      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    679678      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
     679      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open 
    680680      ! 
    681681      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
     
    823823      ENDIF 
    824824      IF( istop == nstop ) THEN   ! no error within this routine 
    825          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 
     825         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
    826826      ENDIF 
    827827      ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/IOM/iom_def.F90

    r12377 r13159  
    3333   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    3434   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    35    INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
     35   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3636 
    3737 
     
    5050   TYPE, PUBLIC ::   file_descriptor 
    5151      CHARACTER(LEN=240)                        ::   name     !: name of the file 
     52      CHARACTER(LEN=3  )                        ::   comp     !: name of component opening the file ('OCE', 'ICE'...) 
    5253      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed) 
    5354                                                              !: jpioipsl option has been removed) 
     
    6465      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6566      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
    66       INTEGER                                   ::   nlev     ! number of vertical levels 
    6767   END TYPE file_descriptor 
    6868   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/IOM/iom_nf90.F90

    r12377 r13159  
    1919   !!---------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
    21    USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height 
     21   USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height 
    2222   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2323   USE iom_def         ! iom variables definitions 
     
    4646CONTAINS 
    4747 
    48    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 
     48   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !!                   ***  SUBROUTINE  iom_open  *** 
     
    5858      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    5959      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
     60      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    6061 
    6162      CHARACTER(LEN=256) ::   clinfo           ! info character 
    6263      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
     64      CHARACTER(LEN=12 ) ::   clfmt            ! writing format 
     65      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open 
     66      INTEGER            ::   idg              ! number of digits 
    6367      INTEGER            ::   iln              ! lengths of character 
    6468      INTEGER            ::   istop            ! temporary storage of nstop 
     
    7074      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7175      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    72       INTEGER            ::   ilevels          ! vertical levels 
    7376      !--------------------------------------------------------------------- 
    7477      ! 
     
    7780      ! 
    7881      !                 !number of vertical levels 
    79       IF( PRESENT(kdlev) )   THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice and abl) 
    80       ELSE                          ;   ilevels = jpk      ! by default jpk 
     82      IF( PRESENT(cdcomp) )   THEN 
     83         IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' ) 
     84         clcomp = cdcomp    ! use input value 
     85      ELSE 
     86         clcomp = 'OCE'     ! by default  
    8187      ENDIF 
    8288      ! 
     
    105111         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    106112            IF( jpnij > 1 ) THEN 
    107                WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     113               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     114               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     115               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 
    108116               cdname = TRIM(cltmp) 
    109117            ENDIF 
     
    125133            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    126134            ! define dimensions 
    127             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), 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 
     135                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
     136                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
     137            SELECT CASE (clcomp) 
     138            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
     139            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo) 
     140            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo) 
     141            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo) 
     142            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
     143            END SELECT 
     144                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    142145            ! global attributes 
    143146            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
     
    165168         ENDDO 
    166169         iom_file(kiomid)%name   = TRIM(cdname) 
     170         iom_file(kiomid)%comp   = clcomp 
    167171         iom_file(kiomid)%nfid   = if90id 
    168172         iom_file(kiomid)%nvars  = 0 
    169173         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    170          iom_file(kiomid)%nlev   = ilevels 
    171174         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    172175         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 
     
    529532      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    530533      CHARACTER(LEN=256)    :: clinfo               ! info character 
    531       CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character 
    532534      INTEGER               :: if90id               ! nf90 file identifier 
    533       INTEGER               :: idmy                 ! dummy variable 
    534535      INTEGER               :: itype                ! variable type 
    535536      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using 
     
    540541      !                                             ! when appropriate (currently chunking is applied to 4d fields only) 
    541542      INTEGER               :: idlv                 ! local variable 
    542       INTEGER               :: idim3                ! id of the third dimension 
    543543      !--------------------------------------------------------------------- 
    544544      ! 
     
    554554         ENDIF 
    555555         ! define the dimension variables if it is not already done 
    556          ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
    557          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)    
    558          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 
    559          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 
    560          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo) 
    561          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo) 
     556         DO jd = 1, 2 
     557            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo) 
     558            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /),   & 
     559               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     560         END DO 
     561         iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2)   ! second dim of first  variable 
     562         iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1)   ! first  dim of second variable 
     563         DO jd = 3, 4 
     564            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo) 
     565            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd   /),   & 
     566               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     567         END DO 
    562568         ! update informations structure related the dimension variable we just added... 
    563569         iom_file(kiomid)%nvars       = 4 
    564570         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 
    565          iom_file(kiomid)%cn_var(1:4) = cltmp(1:4) 
    566571         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
    567          IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension 
    568             CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo) 
    569             iom_file(kiomid)%nvars     = 5 
    570             iom_file(kiomid)%luld(5)   = .FALSE. 
    571             iom_file(kiomid)%cn_var(5) = cltmp(5) 
    572             iom_file(kiomid)%ndims(5)  = 1 
    573          ENDIF 
    574          ! trick: defined to 0 to say that dimension variables are defined but not yet written 
    575          iom_file(kiomid)%dimsz(1, 1)  = 0    
    576572         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    577573      ENDIF 
     
    594590         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    595591         ELSEIF( PRESENT(pv_r1d) ) THEN 
    596             IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN   ;   idim3 = 3 
    597             ELSE                                                               ;   idim3 = 5 
    598             ENDIF 
    599                                               idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    600          ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
     592                                              idims = 2   ;   idimid(1:idims) = (/3,4/) 
     593         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2,4/) 
    601594         ELSEIF( PRESENT(pv_r3d) ) THEN 
    602             IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN   ;   idim3 = 3 
    603             ELSE                                                               ;   idim3 = 5 
    604             ENDIF 
    605                                               idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
     595                                              idims = 4   ;   idimid(1:idims) = (/1,2,3,4/) 
    606596         ENDIF 
    607597         IF( PRESENT(ktype) ) THEN   ! variable external type 
     
    678668            ! ============= 
    679669            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    680             IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    681                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo ) 
    682                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
    683                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo ) 
    684                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    685                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), 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 
    689                IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 
    690                   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 
    691                ENDIF 
    692                ! +++ WRONG VALUE: to be improved but not really useful... 
    693                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 
    694                CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )    
    695                ! update the values of the variables dimensions size 
    696                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 
    697                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 
    698                iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    699                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 
    700                iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
     670            IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN   ! time_counter = 0 
     671               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 1,                            glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
     672               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
     673               SELECT CASE (iom_file(kiomid)%comp) 
     674               CASE ('OCE')   
     675                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo ) 
     676               CASE ('ABL') 
     677                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                            ght_abl ), clinfo ) 
     678               CASE DEFAULT 
     679                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo ) 
     680               END SELECT 
     681               ! "wrong" value: to be improved but not really useful... 
     682               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )    
     683               ! update the size of the variable corresponding to the unlimited dimension 
     684               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more... 
    701685               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    702686            ENDIF 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/ISF/isfdiags.F90

    r12340 r13159  
    8888      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac  ! thickness of the tbl and fraction of last cell affected by the tbl 
    8989      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d        ! 2d var to map in 3d 
    90       CHARACTER(LEN=256), INTENT(in) :: cdvar 
     90      CHARACTER(LEN=*), INTENT(in) :: cdvar 
    9191      !!--------------------------------------------------------------------- 
    9292      INTEGER  :: ji, jj, jk                       ! loop indices 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/LBC/lib_mpp.F90

    r12512 r13159  
    11121112      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5 
    11131113      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10 
     1114      ! 
     1115      CHARACTER(LEN=8) ::   clfmt            ! writing format 
     1116      INTEGER          ::   inum 
    11141117      !!---------------------------------------------------------------------- 
    11151118      ! 
    11161119      nstop = nstop + 1 
    11171120      ! 
    1118       ! force to open ocean.output file if not already opened 
    1119       IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1121      IF( cd1 == 'STOP' .AND. narea /= 1 ) THEN    ! Immediate stop: add an arror message in 'ocean.output' file 
     1122         CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1123         WRITE(inum,*) 
     1124         WRITE(inum,*) ' ==>>>   Look for "E R R O R" messages in all existing *ocean.output* files' 
     1125         CLOSE(inum) 
     1126      ENDIF 
     1127      IF( numout == 6 ) THEN                       ! force to open ocean.output file if not already opened 
     1128         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
     1129      ENDIF 
    11201130      ! 
    11211131                            WRITE(numout,*) 
     
    11451155         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    11461156         WRITE(numout,*)   
     1157         CALL FLUSH(numout) 
     1158         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough... 
    11471159         CALL mppstop( ld_abort = .true. ) 
    11481160      ENDIF 
     
    12071219      ! 
    12081220      CHARACTER(len=80) ::   clfile 
     1221      CHARACTER(LEN=10) ::   clfmt            ! writing format 
    12091222      INTEGER           ::   iost 
     1223      INTEGER           ::   idg              ! number of digits 
    12101224      !!---------------------------------------------------------------------- 
    12111225      ! 
     
    12141228      clfile = TRIM(cdfile) 
    12151229      IF( PRESENT( karea ) ) THEN 
    1216          IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 
     1230         IF( karea > 1 ) THEN 
     1231            ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij 
     1232            idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 )      ! how many digits to we need to write? min=4, max=9 
     1233            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg          ! '(a,a,ix.x)' 
     1234            WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 
     1235         ENDIF 
    12171236      ENDIF 
    12181237#if defined key_agrif 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/LBC/mpp_loc_generic.h90

    r10716 r13159  
    3232      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    3333      INDEX_TYPE(:)                                ! index of minimum in global frame 
    34 # if defined key_mpp_mpi 
    3534      ! 
    3635      INTEGER  ::   ierror, ii, idim 
     
    5655         ! 
    5756         kindex(1) = mig( ilocs(1) ) 
    58 #  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
     57#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
    5958         kindex(2) = mjg( ilocs(2) ) 
    60 #  endif 
    61 #  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
     59#endif 
     60#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
    6261         kindex(3) = ilocs(3) 
    63 #  endif 
     62#endif 
    6463         !  
    6564         DEALLOCATE (ilocs) 
    6665         ! 
    6766         index0 = kindex(1)-1   ! 1d index starting at 0 
    68 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     67#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    6968         index0 = index0 + jpiglo * (kindex(2)-1) 
    70 #  endif 
    71 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     69#endif 
     70#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    7271         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    73 #  endif 
     72#endif 
    7473      END IF 
    7574      zain(1,:) = zmin 
     
    7776      ! 
    7877      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
     78#if defined key_mpp_mpi 
    7979      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     80#else 
     81      zaout(:,:) = zain(:,:) 
     82#endif 
    8083      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    8184      ! 
    8285      pmin      = zaout(1,1) 
    8386      index0    = NINT( zaout(2,1) ) 
    84 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     87#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    8588      kindex(3) = index0 / (jpiglo*jpjglo) 
    8689      index0    = index0 - kindex(3) * (jpiglo*jpjglo) 
    87 #  endif 
    88 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     90#endif 
     91#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    8992      kindex(2) = index0 / jpiglo 
    9093      index0 = index0 - kindex(2) * jpiglo 
    91 #  endif 
     94#endif 
    9295      kindex(1) = index0 
    9396      kindex(:) = kindex(:) + 1   ! start indices at 1 
    94 #else 
    95       kindex = 0 ; pmin = 0. 
    96       WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?' 
    97 #endif 
    9897 
    9998   END SUBROUTINE ROUTINE_LOC 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/OBS/obs_grid.F90

    r10068 r13159  
    684684         & fhistx1, fhistx2, fhisty1, fhisty2 
    685685      REAL(wp) :: histtol 
    686        
     686      CHARACTER(LEN=26) :: clfmt            ! writing format 
     687      INTEGER           :: idg              ! number of digits 
     688  
    687689      IF (ln_grid_search_lookup) THEN 
    688690          
     
    709711 
    710712         IF ( ln_grid_global ) THEN 
    711             WRITE(cfname, FMT="(A,'_',A)") & 
    712                &          TRIM(cn_gridsearchfile), 'global.nc' 
     713            WRITE(cfname, FMT="(A,'_',A)") TRIM(cn_gridsearchfile), 'global.nc' 
    713714         ELSE 
    714             WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") & 
    715                &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj 
     715            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     716            ! define the following format: "(a,a,ix.x,a,ix.x,a,ix.x,a)" 
     717            WRITE(clfmt, "('(a,a,i', i1, '.', i1',a,i', i1, '.', i1',a,i', i1, '.', i1',a)')") idg, idg, idg, idg, idg, idg 
     718            WRITE(cfname,      clfmt     ) TRIM(cn_gridsearchfile),'_', nproc,'of', jpni,'by', jpnj,'.nc' 
    716719         ENDIF 
    717720 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/OBS/obs_write.F90

    r12377 r13159  
    8686      CHARACTER(LEN=40) :: clfname 
    8787      CHARACTER(LEN=10) :: clfiletype 
     88      CHARACTER(LEN=12) :: clfmt            ! writing format 
     89      INTEGER :: idg                        ! number of digits 
    8890      INTEGER :: ilevel 
    8991      INTEGER :: jvar 
     
    181183      fbdata%caddname(1)   = 'Hx' 
    182184 
    183       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     185      idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )            ! how many digits to we need to write? min=4, max=9 
     186      WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     187      WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 
    184188 
    185189      IF(lwp) THEN 
     
    326330      CHARACTER(LEN=10) :: clfiletype 
    327331      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
     332      CHARACTER(LEN=12) :: clfmt           ! writing format 
     333      INTEGER :: idg                       ! number of digits 
    328334      INTEGER :: jo 
    329335      INTEGER :: ja 
     
    453459      fbdata%caddname(1)   = 'Hx' 
    454460 
    455       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     461      idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )            ! how many digits to we need to write? min=4, max=9 
     462      WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     463      WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 
    456464 
    457465      IF(lwp) THEN 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcblk.F90

    r12799 r13159  
    632632 
    633633      END SELECT 
    634  
     634       
     635      IF( iom_use('Cd_oce') )   CALL iom_put("Cd_oce",   zcd_oce * tmask(:,:,1)) 
     636      IF( iom_use('Ce_oce') )   CALL iom_put("Ce_oce",   zce_oce * tmask(:,:,1)) 
     637      IF( iom_use('Ch_oce') )   CALL iom_put("Ch_oce",   zch_oce * tmask(:,:,1)) 
     638      !! LB: mainly here for debugging purpose: 
     639      IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ztpot-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
     640      IF( iom_use('q_zt') )     CALL iom_put("q_zt",     zqair       * tmask(:,:,1)) ! specific humidity       " 
     641      IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (t_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
     642      IF( iom_use('q_zu') )     CALL iom_put("q_zu",     q_zu        * tmask(:,:,1)) ! specific humidity       " 
     643      IF( iom_use('ssq') )      CALL iom_put("ssq",      pssq        * tmask(:,:,1)) ! saturation specific humidity at z=0 
     644      IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu       * tmask(:,:,1)) ! bulk wind speed at z=zu 
     645       
    635646      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    636647         !! ptsk and pssq have been updated!!! 
     
    643654         END WHERE 
    644655      END IF 
    645  
    646       !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef. 
    647       !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef. 
    648  
    649       IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
    650          !! If zu == zt, then ensuring once for all that: 
    651          t_zu(:,:) = ztpot(:,:) 
    652          q_zu(:,:) = zqair(:,:) 
    653       ENDIF 
    654  
    655656 
    656657      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
     
    671672            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                  & 
    672673            &               taum(:,:), psen(:,:), zqla(:,:),                   & 
    673             &               pEvap=pevp(:,:), prhoa=rhoa(:,:)                  ) 
     674            &               pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac ) 
    674675 
    675676         zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
     
    688689         ! ... utau, vtau at U- and V_points, resp. 
    689690         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    690          !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    691          DO_2D_10_10 
     691         !     Note that coastal wind stress is not used in the code... so this extra care has no effect 
     692         DO_2D_00_00 
    692693            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    693694               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
     
    893894         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    894895      ENDIF 
    895  
    896       !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
    897       !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    898  
     896       
     897      IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice) 
     898      IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice) 
     899      IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice) 
     900       
    899901      ! local scalars ( place there for vector optimisation purposes) 
    900902      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
    901903 
    902904      IF( ln_blk ) THEN 
    903          ! ------------------------------------------------------------ ! 
    904          !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
    905          ! ------------------------------------------------------------ ! 
    906          ! C-grid ice dynamics :   U & V-points (same as ocean) 
    907          DO_2D_00_00 
    908             putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             & 
    909                &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          & 
    910                &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) ) 
    911             pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             & 
    912                &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          & 
    913                &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) ) 
     905         ! ------------------------------------------------------------- ! 
     906         !    Wind stress relative to the moving ice ( U10m - U_ice )    ! 
     907         ! ------------------------------------------------------------- ! 
     908         zztmp1 = rn_vfac * 0.5_wp 
     909         DO_2D_01_01    ! at T point  
     910            putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj  ) + puice(ji,jj) ) ) 
     911            pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji  ,jj-1) + pvice(ji,jj) ) ) 
     912         END_2D 
     913         ! 
     914         DO_2D_00_00    ! U & V-points (same as ocean). 
     915            ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     916            zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     917            zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     918            putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj  ) ) 
     919            pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
    914920         END_2D 
    915921         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. ) 
     
    10501056      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub    ! sublimation 
    10511057      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub    ! d(sublimation)/dT 
    1052       zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )   ! evaporation over ocean 
     1058      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean  !LB: removed rn_efac here, correct??? 
    10531059 
    10541060      ! --- evaporation minus precipitation --- ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r12377 r13159  
    194194      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 
    195195 
    196       l_zt_equal_zu = .FALSE. 
    197       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    198197      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    199198 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r12377 r13159  
    194194      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 
    195195 
    196       l_zt_equal_zu = .FALSE. 
    197       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    198197      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    199198 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r12377 r13159  
    9898      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
    9999      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
    100       !!---------------------------------------------------------------------- 
     100      !!---------------------------------------------------------------------------------- 
    101101      !!                      ***  ROUTINE  turb_ecmwf  *** 
    102102      !! 
     
    184184      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    185185      ! 
    186       REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star 
    187       REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu      
    188       REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 
     186      REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 
     187      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 
     188      REAL(wp), DIMENSION(jpi,jpj) :: znu_a         !: Nu_air, Viscosity of air 
    189189      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length... 
    190190      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 
     
    196196      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 
    197197      !!---------------------------------------------------------------------------------- 
    198  
    199198      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
    200199 
    201       l_zt_equal_zu = .FALSE. 
    202       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     200      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    203201 
    204202      !! Initializations for cool skin and warm layer: 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcblk_algo_ncar.F90

    r12377 r13159  
    112112      REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer 
    113113      !!---------------------------------------------------------------------------------- 
    114       ! 
    115       l_zt_equal_zu = .FALSE. 
    116       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     114      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    117115 
    118116      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 
     
    143141      ENDIF 
    144142 
    145       !! Initializing values at z_u with z_t values: 
    146       t_zu = t_zt   ;   q_zu = q_zt 
     143      !! First guess of temperature and humidity at height zu: 
     144      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
     145      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    147146 
    148147      !! ITERATION BLOCK 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcblk_phy.F90

    r12377 r13159  
    3131   REAL(wp), PARAMETER, PUBLIC :: R_vap   = 461.495_wp  !: Specific gas constant for water vapor          [J/K/kg] 
    3232   REAL(wp), PARAMETER, PUBLIC :: reps0   = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622 
    33    REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
     33   REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry - 1._wp  !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    3434   REAL(wp), PARAMETER, PUBLIC :: rCp_air = 1000.5_wp   !: specific heat of air (only used for ice fluxes now...) 
    3535   REAL(wp), PARAMETER, PUBLIC :: rCd_ice = 1.4e-3_wp   !: transfer coefficient over ice 
     
    520520         zCe = zz0*pqst(ji,jj)/zdq 
    521521 
    522          CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
    523             &              zCd, zCh, zCe,                                        & 
    524             &              pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                 & 
    525             &              pTau(ji,jj), zQsen, zQlat ) 
     522         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     523            &                    zCd, zCh, zCe,                                       & 
     524            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
     525            &                    pTau(ji,jj), zQsen, zQlat ) 
    526526 
    527527         zTs2  = pTs(ji,jj)*pTs(ji,jj) 
     
    535535 
    536536 
    537    SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa,  & 
    538       &                          pCd, pCh, pCe,            & 
    539       &                          pwnd, pUb, pslp,          & 
    540       &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
     537   SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
     538      &                          pCd, pCh, pCe,           & 
     539      &                          pwnd, pUb, pslp,         & 
     540      &                          pTau, pQsen, pQlat,      & 
     541      &                          pEvap, prhoa, pfact_evap ) 
     542      !!---------------------------------------------------------------------------------- 
     543      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
     544      REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K] 
     545      REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg] 
     546      REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K] 
     547      REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg] 
     548      REAL(wp), INTENT(in)  :: pCd 
     549      REAL(wp), INTENT(in)  :: pCh 
     550      REAL(wp), INTENT(in)  :: pCe 
     551      REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
     552      REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
     553      REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
     554      !! 
     555      REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
     556      REAL(wp), INTENT(out) :: pQsen !  [W/m^2] 
     557      REAL(wp), INTENT(out) :: pQlat !  [W/m^2] 
     558      !! 
     559      REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
     560      REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
     561      REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 
     562      !! 
     563      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 
     564      INTEGER  :: jq 
     565      !!---------------------------------------------------------------------------------- 
     566      zfact_evap = 1._wp 
     567      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
     568       
     569      !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
     570      ztaa = pTa ! first guess... 
     571      DO jq = 1, 4 
     572         zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !LOLO: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
     573         ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
     574      END DO 
     575      zrho = rho_air(ztaa, pqa, pslp) 
     576      zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
     577 
     578      zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
     579 
     580      pTau = zUrho * pCd * pwnd ! Wind stress module 
     581 
     582      zevap = zUrho * pCe * (pqa - pqs) 
     583      pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 
     584      pQlat = L_vap(pTs) * zevap 
     585 
     586      IF( PRESENT(pEvap) ) pEvap = - zfact_evap * zevap 
     587      IF( PRESENT(prhoa) ) prhoa = zrho 
     588 
     589   END SUBROUTINE BULK_FORMULA_SCLR 
     590 
     591   SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, & 
     592      &                          pCd, pCh, pCe,           & 
     593      &                          pwnd, pUb, pslp,         & 
     594      &                          pTau, pQsen, pQlat,      &  
     595      &                          pEvap, prhoa, pfact_evap )       
    541596      !!---------------------------------------------------------------------------------- 
    542597      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
     
    558613      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
    559614      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
    560       !! 
    561       REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 
    562       INTEGER  :: ji, jj, jq     ! dummy loop indices 
    563       !!---------------------------------------------------------------------------------- 
    564       DO_2D_11_11 
    565  
    566          !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    567          ztaa = pTa(ji,jj) ! first guess... 
    568          DO jq = 1, 4 
    569             zgamma = gamma_moist( 0.5*(ztaa+pTs(ji,jj)) , pqa(ji,jj) ) 
    570             ztaa = pTa(ji,jj) - zgamma*pzu   ! Absolute temp. is slightly colder... 
    571          END DO 
    572          zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)) 
    573          zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    574  
    575          zUrho = pUb(ji,jj)*MAX(zrho, 1._wp)     ! rho*U10 
    576  
    577          pTau(ji,jj) = zUrho * pCd(ji,jj) * pwnd(ji,jj) ! Wind stress module 
    578  
    579          zevap        = zUrho * pCe(ji,jj) * (pqa(ji,jj) - pqs(ji,jj)) 
    580          pQsen(ji,jj) = zUrho * pCh(ji,jj) * (pTa(ji,jj) - pTs(ji,jj)) * cp_air(pqa(ji,jj)) 
    581          pQlat(ji,jj) = L_vap(pTs(ji,jj)) * zevap 
    582  
    583          IF( PRESENT(pEvap) ) pEvap(ji,jj) = - zevap 
     615      REAL(wp),                     INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 
     616      !! 
     617      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 
     618      INTEGER  :: ji, jj 
     619      !!---------------------------------------------------------------------------------- 
     620      zfact_evap = 1._wp 
     621      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
     622 
     623      DO_2D_11_11 
     624 
     625         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     626            &                    pCd(ji,jj), pCh(ji,jj), pCe(ji,jj),                  & 
     627            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
     628            &                    pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj),             & 
     629            &                    pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap       ) 
     630 
     631         IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap 
    584632         IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho 
    585  
     633    
    586634      END_2D 
    587635   END SUBROUTINE BULK_FORMULA_VCTR 
    588  
    589  
    590    SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
    591       &                          pCd, pCh, pCe,           & 
    592       &                          pwnd, pUb, pslp,         & 
    593       &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
    594       !!---------------------------------------------------------------------------------- 
    595       REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
    596       REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K] 
    597       REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg] 
    598       REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K] 
    599       REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg] 
    600       REAL(wp), INTENT(in)  :: pCd 
    601       REAL(wp), INTENT(in)  :: pCh 
    602       REAL(wp), INTENT(in)  :: pCe 
    603       REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
    604       REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
    605       REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
    606       !! 
    607       REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
    608       REAL(wp), INTENT(out) :: pQsen !  [W/m^2] 
    609       REAL(wp), INTENT(out) :: pQlat !  [W/m^2] 
    610       !! 
    611       REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
    612       REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
    613       !! 
    614       REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 
    615       INTEGER  :: jq 
    616       !!---------------------------------------------------------------------------------- 
    617  
    618       !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    619       ztaa = pTa ! first guess... 
    620       DO jq = 1, 4 
    621          zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa ) 
    622          ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
    623       END DO 
    624       zrho = rho_air(ztaa, pqa, pslp) 
    625       zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    626  
    627       zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
    628  
    629       pTau = zUrho * pCd * pwnd ! Wind stress module 
    630  
    631       zevap = zUrho * pCe * (pqa - pqs) 
    632       pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 
    633       pQlat = L_vap(pTs) * zevap 
    634  
    635       IF( PRESENT(pEvap) ) pEvap = - zevap 
    636       IF( PRESENT(prhoa) ) prhoa = zrho 
    637  
    638    END SUBROUTINE BULK_FORMULA_SCLR 
    639  
    640  
    641636 
    642637 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbccpl.F90

    r12489 r13159  
    364364      !  
    365365      ! Vectors: change of sign at north fold ONLY if on the local grid 
    366       IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 
     366      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  & 
     367           .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 
     368 
    367369      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    368370       
     
    11151117         IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 )   & 
    11161118            &   CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    1117          ncpl_qsr_freq = 86400 / ncpl_qsr_freq   ! used by top 
     1119 
     1120         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 
     1121          
    11181122      ENDIF 
    11191123      ! 
     
    14791483      INTEGER ::   ji, jj   ! dummy loop indices 
    14801484      INTEGER ::   itx      ! index of taux over ice 
     1485      REAL(wp)                     ::   zztmp1, zztmp2 
    14811486      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty  
    14821487      !!---------------------------------------------------------------------- 
     
    15421547            p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V) 
    15431548            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    1544          CASE( 'F' ) 
    1545             DO_2D_00_00 
    1546                p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) ) 
    1547                p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) ) 
    1548             END_2D 
    15491549         CASE( 'T' ) 
    15501550            DO_2D_00_00 
    1551                p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
    1552                p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
     1551               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     1552               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     1553               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     1554               p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
     1555               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    15531556            END_2D 
    1554          CASE( 'I' ) 
    1555             DO_2D_00_00 
    1556                p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) ) 
    1557                p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) ) 
    1558             END_2D 
     1557            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    15591558         END SELECT 
    1560          IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN  
    1561             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    1562          ENDIF 
    15631559          
    15641560      ENDIF 
     
    17891785            ENDDO 
    17901786         ELSE 
    1791             qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1787            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17921788            DO jl = 1, jpl 
    1793                zqns_tot(:,:   ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17941789               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    17951790            END DO 
     
    19321927            END DO 
    19331928         ELSE 
    1934             qsr_tot(:,:   ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1929            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19351930            DO jl = 1, jpl 
    1936                zqsr_tot(:,:   ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19371931               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    19381932            END DO 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcmod.F90

    r12489 r13159  
    120120      ncom_fsbc = nn_fsbc    ! make nn_fsbc available for lib_mpp 
    121121#endif 
    122       !                             !* overwrite namelist parameter using CPP key information 
    123 #if defined key_agrif 
    124       IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 
    125          IF( lk_si3  )   nn_ice      = 2 
    126          IF( lk_cice )   nn_ice      = 3 
    127       ENDIF 
    128 !!GS: TBD 
    129 !#else 
    130 !      IF( lk_si3  )   nn_ice      = 2 
    131 !      IF( lk_cice )   nn_ice      = 3 
    132 #endif 
    133122      ! 
    134123      IF(lwp) THEN                  !* Control print 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/SBC/sbcwave.F90

    r12377 r13159  
    210210      END_3D 
    211211      ! 
    212 #if defined key_agrif 
    213       IF( .NOT. Agrif_Root() ) THEN 
    214          IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
    215          IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
    216          IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
    217          IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
    218       ENDIF 
    219 #endif 
    220       ! 
    221212      CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 
    222213      ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/STO/stopar.F90

    r12377 r13159  
    684684      !! ** Purpose :   read stochastic parameters from restart file 
    685685      !!---------------------------------------------------------------------- 
    686       INTEGER  :: jsto, jseed 
     686      INTEGER             ::   jsto, jseed 
     687      INTEGER             ::   idg                 ! number of digits 
    687688      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
    688689      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart) 
    689690      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name 
    690691      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name 
    691       CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name 
     692      CHARACTER(LEN=15)   ::   clseed='seed0_0000' ! seed variable name 
     693      CHARACTER(LEN=6)    ::   clfmt               ! writing format 
    692694      !!---------------------------------------------------------------------- 
    693695 
     
    717719         IF (ln_rstseed) THEN 
    718720            ! Get saved state of the random number generator 
     721            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     722            WRITE(clfmt, "('(i', i1, '.', i1, ')')") idg, idg     ! "(ix.x)" 
    719723            DO jseed = 1 , 4 
    720                WRITE(clseed(5:5) ,'(i1.1)') jseed 
    721                WRITE(clseed(7:10),'(i4.4)') narea 
    722                CALL iom_get( numstor, clseed , zrseed(jseed) ) 
     724               WRITE(clseed(5:5)      ,'(i1.1)') jseed 
     725               WRITE(clseed(7:7+idg-1),  clfmt ) narea 
     726               CALL iom_get( numstor, clseed(1:7+idg-1) , zrseed(jseed) ) 
    723727            END DO 
    724728            ziseed = TRANSFER( zrseed , ziseed) 
     
    742746      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    743747      !! 
    744       INTEGER  :: jsto, jseed 
     748      INTEGER             ::   jsto, jseed 
     749      INTEGER             ::   idg                 ! number of digits 
    745750      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
    746751      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart) 
     
    749754      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name 
    750755      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name 
    751       CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name 
     756      CHARACTER(LEN=15)   ::   clseed='seed0_0000' ! seed variable name 
     757      CHARACTER(LEN=6)    ::   clfmt               ! writing format 
    752758      !!---------------------------------------------------------------------- 
    753759 
     
    771777            CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) ) 
    772778            zrseed = TRANSFER( ziseed , zrseed) 
     779            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     780            WRITE(clfmt, "('(i', i1, '.', i1, ')')") idg, idg     ! "(ix.x)" 
    773781            DO jseed = 1 , 4 
    774                WRITE(clseed(5:5) ,'(i1.1)') jseed 
    775                WRITE(clseed(7:10),'(i4.4)') narea 
    776                CALL iom_rstput( kt, nitrst, numstow, clseed , zrseed(jseed) ) 
     782               WRITE(clseed(5:5)      ,'(i1.1)') jseed 
     783               WRITE(clseed(7:7+idg-1),  clfmt ) narea 
     784               CALL iom_rstput( kt, nitrst, numstow, clseed(1:7+idg-1), zrseed(jseed) ) 
    777785            END DO 
    778786            ! 2D stochastic parameters 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/STO/storng.F90

    r12377 r13159  
    5050 
    5151   ! Parameters to generate real random variates 
    52    REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0  ! +1 
    5352   REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0 
    5453 
     
    275274      REAL(KIND=wp) :: uran 
    276275 
    277       uran = half * ( one + REAL(kiss(),wp) / huge64 ) 
     276      uran = half * ( one + REAL(kiss(),wp) / HUGE(1._wp) ) 
    278277 
    279278   END SUBROUTINE kiss_uniform 
     
    298297         rsq = two 
    299298         DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) ) 
    300             u1 = REAL(kiss(),wp) / huge64 
    301             u2 = REAL(kiss(),wp) / huge64 
     299            u1 = REAL(kiss(),wp) / HUGE(1._wp) 
     300            u2 = REAL(kiss(),wp) / HUGE(1._wp) 
    302301            rsq = u1*u1 + u2*u2 
    303302         ENDDO 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/TRD/trdtra.F90

    r12489 r13159  
    8282      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8383      ! 
    84       INTEGER ::   jk   ! loop indices 
     84      INTEGER ::   jk    ! loop indices 
     85      INTEGER ::   i01   ! 0 or 1 
    8586      REAL(wp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
    8687      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws, ztrdt   ! 3D workspace 
     
    9091         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
    9192      ENDIF 
    92  
     93      ! 
     94      i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 
     95      ! 
    9396      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==! 
    9497         ! 
    95          SELECT CASE( ktrd ) 
     98         SELECT CASE( ktrd*i01 ) 
    9699         !                            ! advection: transform the advective flux into a trend 
    97100         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm )  
     
    112115      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==! 
    113116         ! 
    114          SELECT CASE( ktrd ) 
     117         SELECT CASE( ktrd*i01 ) 
    115118         !                            ! advection: transform the advective flux into a trend 
    116119         !                            !            and send T & S trends to trd_tra_mng 
     
    163166      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==! 
    164167         ! 
    165          SELECT CASE( ktrd ) 
     168         SELECT CASE( ktrd*i01 ) 
    166169         !                            ! advection: transform the advective flux into a masked trend 
    167170         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm )  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/USR/usrdef_zgr.F90

    r12377 r13159  
    202202      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    203203      ! 
    204       k_bot(:,:) = NINT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     204      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere 
    205205      ! 
    206206      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/ZDF/zdftke.F90

    r12489 r13159  
    4545   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    4646   USE zdfmxl         ! vertical physics: mixed layer 
     47#if defined key_si3 
     48   USE ice, ONLY: hm_i, h_i 
     49#endif 
     50#if defined key_cice 
     51   USE sbc_ice, ONLY: h_i 
     52#endif 
    4753   ! 
    4854   USE in_out_manager ! I/O manager 
     
    6470   INTEGER  ::   nn_mxl    ! type of mixing length (=0/1/2/3) 
    6571   REAL(wp) ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m] 
     72   INTEGER  ::      nn_mxlice ! type of scaling under sea-ice 
     73   REAL(wp) ::      rn_mxlice ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    6674   INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1) 
    6775   REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
     
    214222      !                     !  Surface/top/bottom boundary condition on tke 
    215223      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    216        
     224      !  
    217225      DO_2D_00_00 
    218226         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
    219227      END_2D 
    220       IF ( ln_isfcav ) THEN 
    221          DO_2D_00_00 
    222             en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1) 
    223          END_2D 
    224       ENDIF 
    225228      ! 
    226229      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     
    249252               zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  & 
    250253                  &                                           + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  ) 
    251                en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1))   ! masked at ocean surface 
     254               ! (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) = 1 where ice shelves are present 
     255               en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) & 
     256                  &                  + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) 
    252257            END_2D 
    253258         ENDIF 
     
    425430      REAL(wp) ::   zrn2, zraug, zcoef, zav   ! local scalars 
    426431      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    427       REAL(wp) ::   zemxl, zemlm, zemlp       !   -      - 
     432      REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      - 
    428433      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
    429434      !!-------------------------------------------------------------------- 
     
    439444      zmxld(:,:,:)  = rmxl_min 
    440445      ! 
    441       IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     446     IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     447         ! 
    442448         zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
     449#if ! defined key_si3 && ! defined key_cice 
    443450         DO_2D_00_00 
    444             zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
     451            zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    445452         END_2D 
    446       ELSE  
     453#else 
     454         SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     455         ! 
     456         CASE( 0 )                      ! No scaling under sea-ice 
     457            DO_2D_00_00 
     458               zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     459            END_2D 
     460            ! 
     461         CASE( 1 )                           ! scaling with constant sea-ice thickness 
     462            DO_2D_00_00 
     463               zmxlm(ji,jj,1) =  ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 
     464            END_2D 
     465            ! 
     466         CASE( 2 )                                 ! scaling with mean sea-ice thickness 
     467            DO_2D_00_00 
     468#if defined key_si3 
     469               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 
     470#elif defined key_cice 
     471               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     472               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
     473#endif 
     474            END_2D 
     475            ! 
     476         CASE( 3 )                                 ! scaling with max sea-ice thickness 
     477            DO_2D_00_00 
     478               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     479               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
     480            END_2D 
     481            ! 
     482         END SELECT 
     483#endif 
     484         ! 
     485         DO_2D_00_00 
     486            zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
     487         END_2D 
     488         ! 
     489      ELSE 
    447490         zmxlm(:,:,1) = rn_mxl0 
    448491      ENDIF 
     492 
    449493      ! 
    450494      DO_3D_00_00( 2, jpkm1 ) 
     
    518562      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
    519563         DO_3D_00_00( 2, jpkm1 ) 
    520             p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 
     564            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
    521565         END_3D 
    522566      ENDIF 
     
    550594      INTEGER             ::   ios 
    551595      !! 
    552       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,          & 
    553          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,          & 
    554          &                 rn_mxl0 , nn_pdl   , ln_drg , ln_lc    , rn_lc,   & 
    555          &                 nn_etau , nn_htau  , rn_efr , rn_eice   
     596      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,  & 
     597         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,  & 
     598         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
     599         &                 nn_pdl  , ln_drg   , ln_lc    , rn_lc,      & 
     600         &                 nn_etau , nn_htau  , rn_efr   , rn_eice   
    556601      !!---------------------------------------------------------------------- 
    557602      ! 
     
    579624         WRITE(numout,*) '      mixing length type                          nn_mxl    = ', nn_mxl 
    580625         WRITE(numout,*) '         surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0 
     626         IF( ln_mxl0 ) THEN 
     627            WRITE(numout,*) '      type of scaling under sea-ice               nn_mxlice = ', nn_mxlice 
     628            IF( nn_mxlice == 1 ) & 
     629            WRITE(numout,*) '      ice thickness when scaling under sea-ice    rn_mxlice = ', rn_mxlice 
     630         ENDIF          
    581631         WRITE(numout,*) '         surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0 
    582632         WRITE(numout,*) '      top/bottom friction forcing flag            ln_drg    = ', ln_drg 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/nemogcm.F90

    r12489 r13159  
    8484#endif 
    8585   ! 
     86   USE in_out_manager ! I/O manager 
    8687   USE lib_mpp        ! distributed memory computing 
    8788   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     
    185186      END DO 
    186187      ! 
    187       IF( .NOT. Agrif_Root() ) THEN 
    188          CALL Agrif_ParentGrid_To_ChildGrid() 
    189          IF( ln_diaobs )   CALL dia_obs_wri 
    190          IF( ln_timing )   CALL timing_finalize 
    191          CALL Agrif_ChildGrid_To_ParentGrid() 
    192       ENDIF 
    193       ! 
    194188# else 
    195189      ! 
     
    236230      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    237231         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    238          CALL ctl_stop( ctmp1 ) 
     232         IF( ngrdstop > 0 ) THEN 
     233            WRITE(ctmp9,'(i2)') ngrdstop 
     234            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     235            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     236            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     237         ELSE 
     238            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     239            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     240         ENDIF 
    239241      ENDIF 
    240242      ! 
     
    248250#else 
    249251      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS 
    250       ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
     252      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications 
    251253      ENDIF 
    252254#endif 
     
    317319      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    318320      ! open /dev/null file to be able to supress output write easily 
     321      IF( Agrif_Root() ) THEN 
    319322                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    320       ! 
     323#ifdef key_agrif 
     324      ELSE 
     325                  numnul = Agrif_Parent(numnul)    
     326#endif 
     327      ENDIF 
    321328      !                             !--------------------! 
    322329      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp 
     
    329336      ! 
    330337      ! finalize the definition of namctl variables 
    331       IF( sn_cfctl%l_allon ) THEN 
    332          ! Turn on all options. 
    333          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    334          ! Ensure all processors are active 
    335          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    336       ELSEIF( sn_cfctl%l_config ) THEN 
    337          ! Activate finer control of report outputs 
    338          ! optionally switch off output from selected areas (note this only 
    339          ! applies to output which does not involve global communications) 
    340          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    341            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    342            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    343       ELSE 
    344          ! turn off all options. 
    345          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    346       ENDIF 
     338      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     339         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    347340      ! 
    348341      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    528521         WRITE(numout,*) '~~~~~~~~' 
    529522         WRITE(numout,*) '   Namelist namctl' 
    530          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    531          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    532          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    533523         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    534524         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    678668 
    679669    
    680    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     670   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    681671      !!---------------------------------------------------------------------- 
    682672      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    683673      !! 
    684674      !! ** Purpose :   Set elements of the output control structure to setto. 
    685       !!                for_all should be .false. unless all areas are to be 
    686       !!                treated identically. 
    687675      !! 
    688676      !! ** Method  :   Note this routine can be used to switch on/off some 
    689       !!                types of output for selected areas but any output types 
    690       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    691       !!                should be protected from selective switching by the 
    692       !!                for_all argument 
    693       !!---------------------------------------------------------------------- 
    694       LOGICAL :: setto, for_all 
    695       TYPE(sn_ctl) :: sn_cfctl 
    696       !!---------------------------------------------------------------------- 
    697       IF( for_all ) THEN 
    698          sn_cfctl%l_runstat = setto 
    699          sn_cfctl%l_trcstat = setto 
    700       ENDIF 
     677      !!                types of output for selected areas. 
     678      !!---------------------------------------------------------------------- 
     679      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     680      LOGICAL     , INTENT(in   ) :: setto 
     681      !!---------------------------------------------------------------------- 
     682      sn_cfctl%l_runstat = setto 
     683      sn_cfctl%l_trcstat = setto 
    701684      sn_cfctl%l_oceout  = setto 
    702685      sn_cfctl%l_layout  = setto 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/step.F90

    r12489 r13159  
    8282      !!---------------------------------------------------------------------- 
    8383      INTEGER ::   ji, jj, jk   ! dummy loop indice 
    84       INTEGER ::   indic        ! error indicator if < 0 
    8584!!gm kcall can be removed, I guess 
    8685      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt) 
    8786      !! --------------------------------------------------------------------- 
    8887#if defined key_agrif 
     88      IF( nstop > 0 ) RETURN   ! avoid to go further if an error was detected during previous time step (child grid) 
    8989      kstp = nit000 + Agrif_Nb_Step() 
    9090      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     
    114114      ! update I/O and calendar  
    115115      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    116                              indic = 0                ! reset to no error condition 
    117                               
    118116      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    119                              CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including passible AGRIF zoom) 
     117                             CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including possible AGRIF zoom) 
    120118         IF( lk_diamlr   )   CALL dia_mlr_iom_init    ! with additional setup for multiple-linear-regression analysis 
    121119                             CALL iom_init_closedef 
     
    309307#if defined key_agrif 
    310308      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    311       ! AGRIF 
     309      ! AGRIF recursive integration 
    312310      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    313311                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices 
    314312                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
    315313 
    316                          IF( Agrif_NbStepint() == 0 ) THEN 
    317                             CALL Agrif_update_all( )                  ! Update all components 
    318                          ENDIF 
    319 #endif 
    320       IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    321  
     314#endif 
    322315      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    323316      ! Control 
    324317      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    325                          CALL stp_ctl      ( kstp, Nbb, Nnn, indic ) 
    326                           
     318                         CALL stp_ctl      ( kstp, Nnn ) 
     319 
     320#if defined key_agrif 
     321      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     322      ! AGRIF update 
     323      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     324      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN 
     325                         CALL Agrif_update_all( )                  ! Update all components 
     326      ENDIF 
     327 
     328#endif 
     329      IF( ln_diaobs .AND. nstop == 0 )  CALL dia_obs( kstp, Nnn )  ! obs-minus-model (assimilation) diags (after dynamics update) 
     330 
     331      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     332      ! File manipulation at the end of the first time step 
     333      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
    327334      IF( kstp == nit000 ) THEN                          ! 1st time step only 
    328335                                        CALL iom_close( numror )   ! close input  ocean restart file 
     
    334341      ! Coupled mode 
    335342      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    336 !!gm why lk_oasis and not lk_cpl ???? 
    337       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )        ! coupled mode : field exchanges 
     343      IF( lk_oasis .AND. nstop == 0 )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges 
    338344      ! 
    339345#if defined key_iomput 
    340       IF( kstp == nitend .OR. indic < 0 ) THEN  
     346      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     347      ! Finalize contextes if end of simulation or error detected 
     348      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
     349      IF( kstp == nitend .OR. nstop > 0 ) THEN  
    341350                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
    342                       IF(lrxios) CALL iom_context_finalize(      crxios_context          ) 
     351         IF( lrxios ) CALL iom_context_finalize(      crxios_context         ) 
    343352         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
    344353      ENDIF 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/stpctl.F90

    r12377 r13159  
    1919   USE dom_oce         ! ocean space and time domain variables  
    2020   USE c1d             ! 1D vertical configuration 
     21   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
     22   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
     23   !   
    2124   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2325   USE in_out_manager  ! I/O manager 
    2426   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2527   USE lib_mpp         ! distributed memory computing 
    26    USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    27    USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    28  
     28   ! 
    2929   USE netcdf          ! NetCDF library 
    3030   IMPLICIT NONE 
     
    3333   PUBLIC stp_ctl           ! routine called by step.F90 
    3434 
    35    INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 
    36    LOGICAL  ::   lsomeoce 
     35   INTEGER                ::   nrunid   ! netcdf file id 
     36   INTEGER, DIMENSION(8)  ::   nvarid   ! netcdf variable id 
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4242CONTAINS 
    4343 
    44    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     44   SUBROUTINE stp_ctl( kt, Kmm ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                    ***  ROUTINE stp_ctl  *** 
     
    5050      !! ** Method  : - Save the time step in numstp 
    5151      !!              - Print it each 50 time steps 
    52       !!              - Stop the run IF problem encountered by setting indic=-3 
     52      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5353      !!                Problems checked: |ssh| maximum larger than 10 m 
    5454      !!                                  |U|   maximum larger than 10 m/s  
     
    5757      !! ** Actions :   "time.step" file = last ocean time-step 
    5858      !!                "run.stat"  file = run statistics 
    59       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     59      !!                 nstop indicator sheared among all local domain 
    6060      !!---------------------------------------------------------------------- 
    6161      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    62       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    63       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    64       !! 
    65       INTEGER                ::   ji, jj, jk          ! dummy loop indices 
    66       INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
    67       INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
    68       REAL(wp)               ::   zzz                 ! local real  
    69       REAL(wp), DIMENSION(9) ::   zmax 
    70       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    71       CHARACTER(len=20) :: clname 
    72       !!---------------------------------------------------------------------- 
    73       ! 
    74       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    75       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    76       ll_wrtruns = ll_colruns .AND. lwm 
    77       IF( kt == nit000 .AND. lwp ) THEN 
    78          WRITE(numout,*) 
    79          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    80          WRITE(numout,*) '~~~~~~~' 
    81          !                                ! open time.step file 
    82          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    83          !                                ! open run.stat file(s) at start whatever 
    84          !                                ! the value of sn_cfctl%ptimincr 
    85          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     62      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     63      !! 
     64      INTEGER                         ::   ji                                    ! dummy loop indices 
     65      INTEGER                         ::   idtime, istatus 
     66      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax 
     67      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
     68      REAL(wp)                        ::   zzz                                   ! local real  
     69      REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal 
     70      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     71      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
     72      CHARACTER(len=20)               ::   clname 
     73      !!---------------------------------------------------------------------- 
     74      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     75      ! 
     76      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     77      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     78      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     79      ! 
     80      IF( kt == nit000 ) THEN 
     81         ! 
     82         IF( lwp ) THEN 
     83            WRITE(numout,*) 
     84            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     85            WRITE(numout,*) '~~~~~~~' 
     86         ENDIF 
     87         !                                ! open time.step    ascii file, done only by 1st subdomain 
     88         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     89         ! 
     90         IF( ll_wrtruns ) THEN 
     91            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    8692            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     93            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    8794            clname = 'run.stat.nc' 
    8895            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    89             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    90             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    91             istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 
    92             istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu  ) 
    93             istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1 ) 
    94             istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2 ) 
    95             istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1 ) 
    96             istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2 ) 
     96            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     97            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     99            istatus = NF90_DEF_VAR( nrunid,   'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     100            istatus = NF90_DEF_VAR( nrunid,       's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     101            istatus = NF90_DEF_VAR( nrunid,       's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 
     102            istatus = NF90_DEF_VAR( nrunid,       't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 
     103            istatus = NF90_DEF_VAR( nrunid,       't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 
    97104            IF( ln_zad_Aimp ) THEN 
    98                istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1 ) 
    99                istatus = NF90_DEF_VAR( idrun,       'Cf_max', NF90_DOUBLE, (/ idtime /), idc1 ) 
     105               istatus = NF90_DEF_VAR( nrunid,   'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 
     106               istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 
    100107            ENDIF 
    101             istatus = NF90_ENDDEF(idrun) 
    102             zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use 
    103          ENDIF 
    104       ENDIF 
    105       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    106       ! 
    107       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     108            istatus = NF90_ENDDEF(nrunid) 
     109         ENDIF 
     110         !     
     111      ENDIF 
     112      ! 
     113      !                                   !==              write current time step              ==! 
     114      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     115      IF( lwm .AND. ll_wrtstp ) THEN 
    108116         WRITE ( numstp, '(1x, i8)' )   kt 
    109117         REWIND( numstp ) 
    110118      ENDIF 
    111       ! 
    112       !                                   !==  test of extrema  ==! 
    113       IF( ll_wd ) THEN 
    114          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
    115       ELSE 
    116          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max 
    117       ENDIF 
    118       zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only) 
    119       zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
    120       zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
    121       zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
    122       zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
    123       zmax(7) = REAL( nstop , wp )                                            ! stop indicator 
    124       IF( ln_zad_Aimp ) THEN 
    125          zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 
    126          zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) ! partitioning coeff. max 
    127       ENDIF 
    128       ! 
     119      !                                   !==            test of local extrema           ==! 
     120      !                                   !==  done by all processes at every time step  ==! 
     121      ! 
     122      ! define zmax default value. needed for land processors 
     123      IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     124         zmax(:) = -HUGE(1._wp) 
     125      ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     126         zmax(:) =  0._wp 
     127         zmax(3) = -1._wp      ! avoid salinity minimum at 0. 
     128      ENDIF 
     129      ! 
     130      llmsk(:,:,1) = ssmask(:,:) == 1._wp 
     131      IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     132         IF( ll_wd ) THEN 
     133            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     134         ELSE 
     135            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
     136         ENDIF 
     137      ENDIF 
     138      zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) )                                       ! velocity max (zonal only) 
     139      llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
     140      IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     141         zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
     142         zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     143         IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
     144            zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
     145            zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     146            IF( ln_zad_Aimp ) THEN 
     147               zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
     148               llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
     149               IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     150                  zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk )                  ! implicit vertical vel. max 
     151               ENDIF 
     152            ENDIF 
     153         ENDIF 
     154      ENDIF 
     155      zmax(9) = REAL( nstop, wp )                                              ! stop indicator 
     156      !                                   !==               get global extrema             ==! 
     157      !                                   !==  done by all processes if writting run.stat  ==! 
    129158      IF( ll_colruns ) THEN 
     159         zmaxlocal(:) = zmax(:) 
    130160         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    131          nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains 
    132       ENDIF 
    133       !                                   !==  run statistics  ==!   ("run.stat" files) 
     161         nstop = NINT( zmax(9) )                 ! update nstop indicator (now sheared among all local domains) 
     162      ENDIF 
     163      !                                   !==              write "run.stat" files              ==! 
     164      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    134165      IF( ll_wrtruns ) THEN 
    135166         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    136          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    137          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    138          istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) ) 
    139          istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) ) 
    140          istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) ) 
    141          istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) ) 
     167         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     168         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     169         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 
     170         istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 
     171         istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 
     172         istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 
    142173         IF( ln_zad_Aimp ) THEN 
    143             istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) ) 
    144             istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) ) 
    145          ENDIF 
    146          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    147          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     174            istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 
     175            istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 
     176         ENDIF 
     177         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    148178      END IF 
    149       !                                   !==  error handling  ==! 
    150       IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges 
    151          &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m ) 
    152          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
    153          &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
    154          &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
    155          &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
    156          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    157          IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN 
    158             ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed) 
    159             CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  ) 
    160             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  ) 
    161             CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 
    162             CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 
     179      !                                   !==               error handling               ==! 
     180      !                                   !==  done by all processes at every time step  ==! 
     181      ! 
     182      IF(   zmax(1) >   20._wp .OR.   &                   ! too large sea surface height ( > 20 m ) 
     183         &  zmax(2) >   10._wp .OR.   &                   ! too large velocity ( > 10 m/s) 
     184         &  zmax(3) >=   0._wp .OR.   &                   ! negative or zero sea surface salinity 
     185         &  zmax(4) >= 100._wp .OR.   &                   ! too large sea surface salinity ( > 100 ) 
     186         &  zmax(4) <    0._wp .OR.   &                   ! too large sea surface salinity (keep this line for sea-ice) 
     187         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     188         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     189         ! 
     190         iloc(:,:) = 0 
     191         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     192            ! first: close the netcdf file, so we can read it 
     193            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     194            ! get global loc on the min/max 
     195            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     196            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)),  umask(:,:,:), zzz, iloc(1:3,2) ) 
     197            CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,3) ) 
     198            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,4) ) 
     199            ! find which subdomain has the max. 
     200            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     201            DO ji = 1, 9 
     202               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     203                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     204               ENDIF 
     205            END DO 
     206            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     207            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     208            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     209         ELSE                    ! find local min and max locations: 
     210            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     211            iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
     212            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     213            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     214            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     215            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     216         ENDIF 
     217         ! 
     218         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
     219         CALL wrt_line( ctmp2, kt, '|ssh| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     220         CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     221         CALL wrt_line( ctmp4, kt, 'Sal   min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     222         CALL wrt_line( ctmp5, kt, 'Sal   max',  zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 
     223         IF( Agrif_Root() ) THEN 
     224            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    163225         ELSE 
    164             ! find local min and max locations 
    165             ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
    166             iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    167             is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    168             is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    169          ENDIF 
    170           
    171          WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    172          WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2) 
    173          WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    174          WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
    175          WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
    176          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    177           
     226            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     227         ENDIF 
     228         ! 
    178229         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    179           
    180          IF( .NOT. sn_cfctl%l_glochk ) THEN 
    181             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    182             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 ) 
    183          ELSE 
    184             CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' ) 
    185          ENDIF 
    186  
    187          kindic = -3 
    188          ! 
    189       ENDIF 
    190       ! 
    191 9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
    192 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    193 9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
    194 9400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
     230         ! 
     231         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     232            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     233            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     234            ENDIF 
     235         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     236            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     237         ENDIF 
     238         ! 
     239      ENDIF 
     240      ! 
     241      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     242         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     243         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     244      ENDIF 
     245      ! 
    1952469500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    196247      ! 
    197248   END SUBROUTINE stp_ctl 
     249 
     250 
     251   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     252      !!---------------------------------------------------------------------- 
     253      !!                     ***  ROUTINE wrt_line  *** 
     254      !! 
     255      !! ** Purpose :   write information line 
     256      !! 
     257      !!---------------------------------------------------------------------- 
     258      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     259      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     260      REAL(wp),              INTENT(in   ) ::   pval 
     261      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     262      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     263      ! 
     264      CHARACTER(len=80) ::   clsuff 
     265      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     266      CHARACTER(len=9 ) ::   cli, clj, clk 
     267      CHARACTER(len=1 ) ::   clfmt 
     268      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     269      INTEGER           ::   ifmtk 
     270      !!---------------------------------------------------------------------- 
     271      WRITE(clkt , '(i9)') kt 
     272       
     273      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     274      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     275      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     276      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     277      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     278                                   WRITE(clmax, cl4) kmax-1 
     279      ! 
     280      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     281      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     282      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     283      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     284      ! 
     285      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     286      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     287      ENDIF 
     288      IF(kloc(3) == 0) THEN 
     289         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     290         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     291         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     292      ELSE 
     293         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     294         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     295         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     296         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     297      ENDIF 
     298      ! 
     2999100  FORMAT('MPI rank ', a) 
     3009200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     3019300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     3029400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     303      ! 
     304   END SUBROUTINE wrt_line 
     305 
    198306 
    199307   !!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OFF/nemogcm.F90

    r12377 r13159  
    2828   USE usrdef_nam     ! user defined configuration 
    2929   USE eosbn2         ! equation of state            (eos bn2 routine) 
     30   USE bdy_oce,  ONLY : ln_bdy 
     31   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    3032   !              ! ocean physics 
    3133   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine) 
     
    9092      !!              Madec, 2008, internal report, IPSL. 
    9193      !!---------------------------------------------------------------------- 
    92       INTEGER :: istp, indic       ! time step index 
     94      INTEGER :: istp       ! time step index 
    9395      !!---------------------------------------------------------------------- 
    9496 
     
    130132         IF( .NOT.ln_linssh )   CALL dta_dyn_sf_interp( istp, Nnn )  ! calculate now grid parameters 
    131133#endif 
    132                                 CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
     134                                CALL stp_ctl    ( istp )             ! Time loop: control and print 
    133135         istp = istp + 1 
    134136      END DO 
     
    145147      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
    146148         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    147          CALL ctl_stop( ctmp1 ) 
     149         WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     150         CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    148151      ENDIF 
    149152      ! 
     
    209212      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    210213      ! open /dev/null file to be able to supress output write easily 
     214      IF( Agrif_Root() ) THEN 
    211215                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     216#ifdef key_agrif 
     217      ELSE 
     218                  numnul = Agrif_Parent(numnul)    
     219#endif 
     220      ENDIF 
    212221      ! 
    213222      !                             !--------------------! 
     
    221230      ! 
    222231      ! finalize the definition of namctl variables 
    223       IF( sn_cfctl%l_allon ) THEN 
    224          ! Turn on all options. 
    225          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    226          ! Ensure all processors are active 
    227          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    228       ELSEIF( sn_cfctl%l_config ) THEN 
    229          ! Activate finer control of report outputs 
    230          ! optionally switch off output from selected areas (note this only 
    231          ! applies to output which does not involve global communications) 
    232          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    233            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    234            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    235       ELSE 
    236          ! turn off all options. 
    237          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    238       ENDIF 
     232      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     233         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    239234      ! 
    240235      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    301296      ! Initialise time level indices 
    302297      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    303     
    304298 
    305299      !                             !-------------------------------! 
     
    323317 
    324318                           CALL     sbc_init( Nbb, Nnn, Naa )    ! Forcings : surface module 
     319                           CALL     bdy_init    ! Open boundaries initialisation     
    325320 
    326321      !                                      ! Tracer physics 
     
    365360         WRITE(numout,*) '~~~~~~~~' 
    366361         WRITE(numout,*) '   Namelist namctl' 
    367          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    368          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    369          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    370362         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    371363         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    486478      USE zdf_oce,   ONLY : zdf_oce_alloc 
    487479      USE trc_oce,   ONLY : trc_oce_alloc 
     480      USE bdy_oce,   ONLY : bdy_oce_alloc 
    488481      ! 
    489482      INTEGER :: ierr 
     
    495488      ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics 
    496489      ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays 
     490      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)       
    497491      ! 
    498492      CALL mpp_sum( 'nemogcm', ierr ) 
     
    501495   END SUBROUTINE nemo_alloc 
    502496 
    503    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     497   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    504498      !!---------------------------------------------------------------------- 
    505499      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    506500      !! 
    507501      !! ** Purpose :   Set elements of the output control structure to setto. 
    508       !!                for_all should be .false. unless all areas are to be 
    509       !!                treated identically. 
    510       !! 
     502     !! 
    511503      !! ** Method  :   Note this routine can be used to switch on/off some 
    512       !!                types of output for selected areas but any output types 
    513       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    514       !!                should be protected from selective switching by the 
    515       !!                for_all argument 
    516       !!---------------------------------------------------------------------- 
    517       LOGICAL :: setto, for_all 
    518       TYPE(sn_ctl) :: sn_cfctl 
    519       !!---------------------------------------------------------------------- 
    520       IF( for_all ) THEN 
    521          sn_cfctl%l_runstat = setto 
    522          sn_cfctl%l_trcstat = setto 
    523       ENDIF 
     504      !!                types of output for selected areas. 
     505      !!---------------------------------------------------------------------- 
     506      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     507      LOGICAL     , INTENT(in   ) :: setto 
     508      !!---------------------------------------------------------------------- 
     509      sn_cfctl%l_runstat = setto 
     510      sn_cfctl%l_trcstat = setto 
    524511      sn_cfctl%l_oceout  = setto 
    525512      sn_cfctl%l_layout  = setto 
     
    551538 
    552539 
    553    SUBROUTINE stp_ctl( kt, kindic ) 
     540   SUBROUTINE stp_ctl( kt ) 
    554541      !!---------------------------------------------------------------------- 
    555542      !!                    ***  ROUTINE stp_ctl  *** 
     
    562549      !!---------------------------------------------------------------------- 
    563550      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
    564       INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
    565551      !!---------------------------------------------------------------------- 
    566552      ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAO/nemogcm.F90

    r12377 r13159  
    2929   USE sao_intp 
    3030   ! 
     31   USE in_out_manager ! I/O manager 
    3132   USE lib_mpp        ! distributed memory computing 
    3233   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     
    139140      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    140141      ! open /dev/null file to be able to supress output write easily 
     142      IF( Agrif_Root() ) THEN 
    141143                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     144#ifdef key_agrif 
     145      ELSE 
     146                  numnul = Agrif_Parent(numnul)    
     147#endif 
     148      ENDIF 
    142149      ! 
    143150      !                             !--------------------! 
     
    151158      ! 
    152159      ! finalize the definition of namctl variables 
    153       IF( sn_cfctl%l_allon ) THEN 
    154          ! Turn on all options. 
    155          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    156          ! Ensure all processors are active 
    157          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    158       ELSEIF( sn_cfctl%l_config ) THEN 
    159          ! Activate finer control of report outputs 
    160          ! optionally switch off output from selected areas (note this only 
    161          ! applies to output which does not involve global communications) 
    162          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    163            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    164            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    165       ELSE 
    166          ! turn off all options. 
    167          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    168       ENDIF 
     160      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     161         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    169162      ! 
    170163      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    263256         WRITE(numout,*) '~~~~~~~~' 
    264257         WRITE(numout,*) '   Namelist namctl' 
    265          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    266          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    267          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    268258         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    269259         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    403393   END SUBROUTINE nemo_alloc 
    404394 
    405    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     395   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    406396      !!---------------------------------------------------------------------- 
    407397      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    408398      !! 
    409399      !! ** Purpose :   Set elements of the output control structure to setto. 
    410       !!                for_all should be .false. unless all areas are to be 
    411       !!                treated identically. 
    412400      !! 
    413401      !! ** Method  :   Note this routine can be used to switch on/off some 
    414       !!                types of output for selected areas but any output types 
    415       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    416       !!                should be protected from selective switching by the 
    417       !!                for_all argument 
    418       !!---------------------------------------------------------------------- 
    419       LOGICAL :: setto, for_all 
    420       TYPE(sn_ctl) :: sn_cfctl 
    421       !!---------------------------------------------------------------------- 
    422       IF( for_all ) THEN 
    423          sn_cfctl%l_runstat = setto 
    424          sn_cfctl%l_trcstat = setto 
    425       ENDIF 
     402      !!                types of output for selected areas. 
     403      !!---------------------------------------------------------------------- 
     404      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     405      LOGICAL     , INTENT(in   ) :: setto 
     406      !!---------------------------------------------------------------------- 
     407      sn_cfctl%l_runstat = setto 
     408      sn_cfctl%l_trcstat = setto 
    426409      sn_cfctl%l_oceout  = setto 
    427410      sn_cfctl%l_layout  = setto 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/diawri.F90

    r12489 r13159  
    9999      ! Output the initial state and forcings 
    100100      IF( ninist == 1 ) THEN 
    101          CALL dia_wri_state( 'output.init', Kmm ) 
     101         CALL dia_wri_state( Kmm, 'output.init' ) 
    102102         ninist = 0 
    103103      ENDIF 
     
    126126   END FUNCTION dia_wri_alloc_abl 
    127127   
    128    SUBROUTINE dia_wri( kt ) 
     128   SUBROUTINE dia_wri( kt, Kmm ) 
    129129      !!--------------------------------------------------------------------- 
    130130      !!                  ***  ROUTINE dia_wri  *** 
     
    138138      !!      Each nn_write time step, output the instantaneous or mean fields 
    139139      !!---------------------------------------------------------------------- 
    140       !! 
    141140      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     141      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index 
    142142      !! 
    143143      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
     
    154154      ! Output the initial state and forcings 
    155155      IF( ninist == 1 ) THEN                        
    156          CALL dia_wri_state( 'output.init' ) 
     156         CALL dia_wri_state( Kmm, 'output.init' ) 
    157157         ninist = 0 
    158158      ENDIF 
     
    257257         IF( ln_abl ) THEN  
    258258         ! Define the ABL grid FILE ( nid_A ) 
    259             CALL dia_nam( clhstnam, nwrite, 'grid_ABL' ) 
     259            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
    260260            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
    261261            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     
    414414#endif 
    415415 
    416    SUBROUTINE dia_wri_state( cdfile_name, Kmm ) 
     416   SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 
    417417      !!--------------------------------------------------------------------- 
    418418      !!                 ***  ROUTINE dia_wri_state  *** 
     
    427427      !!      File 'output.abort.nc' is created in case of abnormal job end 
    428428      !!---------------------------------------------------------------------- 
     429      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    429430      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    430       INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    431431      !! 
    432432      INTEGER :: inum 
     
    437437      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    438438      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    439  
    440 #if defined key_si3 
    441      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    442 #else 
    443      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    444 #endif 
    445  
     439      ! 
     440      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     441      ! 
    446442      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature 
    447443      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity 
     
    456452      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress 
    457453      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress 
    458   
     454      ! 
     455      CALL iom_close( inum ) 
     456      ! 
    459457#if defined key_si3 
    460458      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     459         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    461460         CALL ice_wri_state( inum ) 
    462       ENDIF 
    463 #endif 
    464       ! 
    465       CALL iom_close( inum ) 
    466       ! 
     461         CALL iom_close( inum ) 
     462      ENDIF 
     463      ! 
     464#endif 
    467465   END SUBROUTINE dia_wri_state 
    468466 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/nemogcm.F90

    r12489 r13159  
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3636   ! 
     37   USE in_out_manager ! I/O manager 
    3738   USE lib_mpp        ! distributed memory computing 
    3839   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     
    125126      END DO 
    126127      ! 
    127       IF( .NOT. Agrif_Root() ) THEN 
    128          CALL Agrif_ParentGrid_To_ChildGrid() 
    129          IF( ln_timing )   CALL timing_finalize 
    130          CALL Agrif_ChildGrid_To_ParentGrid() 
    131       ENDIF 
    132       ! 
    133128#else 
    134129      ! 
     
    165160      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    166161         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    167          CALL ctl_stop( ctmp1 ) 
     162         IF( ngrdstop > 0 ) THEN 
     163            WRITE(ctmp9,'(i2)') ngrdstop 
     164            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     165            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     166            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     167         ELSE 
     168            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     169            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     170         ENDIF 
    168171      ENDIF 
    169172      ! 
     
    256259      ENDIF 
    257260      ! open /dev/null file to be able to supress output write easily 
     261      IF( Agrif_Root() ) THEN 
    258262                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     263#ifdef key_agrif 
     264      ELSE 
     265                  numnul = Agrif_Parent(numnul)    
     266#endif 
     267      ENDIF 
    259268      ! 
    260269      !                             !--------------------! 
     
    268277      ! 
    269278      ! finalize the definition of namctl variables 
    270       IF( sn_cfctl%l_allon ) THEN 
    271          ! Turn on all options. 
    272          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    273          ! Ensure all processors are active 
    274          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    275       ELSEIF( sn_cfctl%l_config ) THEN 
    276          ! Activate finer control of report outputs 
    277          ! optionally switch off output from selected areas (note this only 
    278          ! applies to output which does not involve global communications) 
    279          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    280            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    281            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    282       ELSE 
    283          ! turn off all options. 
    284          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    285       ENDIF 
     279      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     280         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    286281      ! 
    287282      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    401396         WRITE(numout,*) '~~~~~~~~' 
    402397         WRITE(numout,*) '   Namelist namctl' 
    403          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    404          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    405          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    406398         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    407399         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    545537   END SUBROUTINE nemo_alloc 
    546538 
    547    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     539   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    548540      !!---------------------------------------------------------------------- 
    549541      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    550542      !! 
    551543      !! ** Purpose :   Set elements of the output control structure to setto. 
    552       !!                for_all should be .false. unless all areas are to be 
    553       !!                treated identically. 
    554544      !! 
    555545      !! ** Method  :   Note this routine can be used to switch on/off some 
    556       !!                types of output for selected areas but any output types 
    557       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    558       !!                should be protected from selective switching by the 
    559       !!                for_all argument 
    560       !!---------------------------------------------------------------------- 
    561       LOGICAL :: setto, for_all 
    562       TYPE(sn_ctl) :: sn_cfctl 
    563       !!---------------------------------------------------------------------- 
    564       IF( for_all ) THEN 
    565          sn_cfctl%l_runstat = setto 
    566          sn_cfctl%l_trcstat = setto 
    567       ENDIF 
     546      !!                types of output for selected areas. 
     547      !!---------------------------------------------------------------------- 
     548      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     549      LOGICAL     , INTENT(in   ) :: setto 
     550      !!---------------------------------------------------------------------- 
     551      sn_cfctl%l_runstat = setto 
     552      sn_cfctl%l_trcstat = setto 
    568553      sn_cfctl%l_oceout  = setto 
    569554      sn_cfctl%l_layout  = setto 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/sbcssm.F90

    r12377 r13159  
    2626   USE lib_mpp        ! distributed memory computing library 
    2727   USE prtctl         ! print control 
    28    USE fldread        ! read input fields  
     28   USE fldread        ! read input fields 
    2929   USE timing         ! Timing 
    3030 
     
    3838   LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D 
    3939   LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not 
    40     
     40 
    4141   LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion 
    4242   LOGICAL            ::   l_initdone = .false. 
     
    6969      !!               for an off-line simulation using surface processes only 
    7070      !! 
    71       !! ** Method : calculates the position of data  
     71      !! ** Method : calculates the position of data 
    7272      !!             - interpolates data if needed 
    7373      !!---------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7575      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    76                           ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
     76      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7777      ! 
    7878      INTEGER  ::   ji, jj     ! dummy loop indices 
     
    8282      ! 
    8383      IF( ln_timing )   CALL timing_start( 'sbc_ssm') 
    84       
     84 
    8585      IF ( l_sasread ) THEN 
    8686         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
    8787         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    88          !  
     88         ! 
    8989         IF( ln_3d_uve ) THEN 
    9090            IF( .NOT. ln_linssh ) THEN 
    91                e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     91               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    9292            ELSE 
    9393               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    9494            ENDIF 
    9595            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    96             ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     96            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    9797         ELSE 
    9898            IF( .NOT. ln_linssh ) THEN 
    99                e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     99               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    100100            ELSE 
    101101               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    102102            ENDIF 
    103103            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    104             ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     104            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    105105         ENDIF 
    106106         ! 
     
    123123         ssh  (:,:,Kmm) = 0._wp                              !              - - 
    124124      ENDIF 
    125        
     125 
    126126      IF ( nn_ice == 1 ) THEN 
    127127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 
     
    132132      uu (:,:,1,Kbb) = ssu_m(:,:) 
    133133      vv (:,:,1,Kbb) = ssv_m(:,:) 
    134   
     134 
    135135      IF(sn_cfctl%l_prtctl) THEN            ! print control 
    136136         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   ) 
     
    162162      !!                  ***  ROUTINE sbc_ssm_init  *** 
    163163      !! 
    164       !! ** Purpose :   Initialisation of sea surface mean data      
    165       !!---------------------------------------------------------------------- 
    166       INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices  
    167                           ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
     164      !! ** Purpose :   Initialisation of sea surface mean data 
     165      !!---------------------------------------------------------------------- 
     166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     167      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    168168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    169169      INTEGER  :: ifpr                               ! dummy loop indice 
     
    195195902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 
    196196      IF(lwm) WRITE ( numond, namsbc_sas ) 
    197       !            
     197      ! 
    198198      IF(lwp) THEN                              ! Control print 
    199199         WRITE(numout,*) '   Namelist namsbc_sas' 
    200          WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread  
     200         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
    201201         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    202202         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
     
    226226         ln_closea = .false. 
    227227      ENDIF 
    228        
    229       !                   
     228 
     229      ! 
    230230      IF( l_sasread ) THEN                       ! store namelist information in an array 
    231          !  
     231         ! 
    232232         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    233233         !! when we have other 3d arrays that we need to read in 
     
    275275         ENDIF 
    276276         ! 
    277          ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
     277         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
    278278         IF( nfld_3d > 0 ) THEN 
    279279            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
     
    282282            ENDIF 
    283283            DO ifpr = 1, nfld_3d 
    284                                             ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
     284               ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
    285285               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 ) 
    286286               IF( ierr0 + ierr1 > 0 ) THEN 
     
    298298            ENDIF 
    299299            DO ifpr = 1, nfld_2d 
    300                                             ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     300               ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
    301301               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
    302302               IF( ierr0 + ierr1 > 0 ) THEN 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/step.F90

    r12377 r13159  
    7474      !!              -2- Outputs and diagnostics 
    7575      !!---------------------------------------------------------------------- 
    76       INTEGER ::   indic    ! error indicator if < 0 
    77       !! --------------------------------------------------------------------- 
    7876 
    7977#if defined key_agrif 
     78      IF( nstop > 0 ) RETURN   ! avoid to go further if an error was detected during previous time step (child grid) 
    8079      kstp = nit000 + Agrif_Nb_Step() 
    8180      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    82       IF ( lk_agrif_debug ) THEN 
    83          IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    84          IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 
     81      IF( lk_agrif_debug ) THEN 
     82         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---' 
     83         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 
    8584      ENDIF 
    86  
    87       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    88  
     85      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE. 
    8986# if defined key_iomput 
    9087      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    9188# endif    
    9289#endif    
    93                              indic = 0                    ! although indic is not changed in stp_ctl 
    94                                                           ! need to keep the same interface  
    9590      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    9691      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
     
    109104#if defined key_agrif 
    110105      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    111       ! AGRIF 
     106      ! AGRIF recursive integration 
    112107      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    113                              CALL Agrif_Integrate_ChildGrids( stp )   
     108                             CALL Agrif_Integrate_ChildGrids( stp ) 
     109                              
     110#endif                              
     111      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     112      ! Control 
     113      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     114                             CALL stp_ctl( kstp, Nnn ) 
    114115 
    115       IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update from zoom N to zoom 1 then to Parent  
     116#if defined key_agrif 
     117      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     118      ! AGRIF update 
     119      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     120      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN                       ! AGRIF Update from zoom N to zoom 1 then to Parent  
    116121#if defined key_si3 
    117122                             CALL Agrif_Update_ice( )   ! update sea-ice 
    118123#endif 
    119124      ENDIF 
     125 
    120126#endif 
    121                               
    122127      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    123       ! Control 
    124       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    125                              CALL stp_ctl( kstp, indic ) 
    126       IF( indic < 0  )  THEN 
    127                              CALL ctl_stop( 'step: indic < 0' ) 
    128                              CALL dia_wri_state( 'output.abort', Nnn ) 
    129       ENDIF 
    130       IF( kstp == nit000   ) CALL iom_close( numror )           ! close input  ocean restart file 
     128      ! File manipulation at the end of the first time step 
     129      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
     130      IF( kstp == nit000   ) CALL iom_close( numror )                          ! close input  ocean restart file 
    131131       
    132132      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    133133      ! Coupled mode 
    134134      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    135       IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
     135      IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn )       ! coupled mode : field exchanges if OASIS-coupled ice 
    136136 
    137137#if defined key_iomput 
     
    144144         lrst_oce = .FALSE. 
    145145      ENDIF 
    146       IF( kstp == nitend .OR. indic < 0 ) THEN 
    147                              CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
     146      IF( kstp == nitend .OR. nstop > 0 ) THEN 
     147         CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    148148      ENDIF 
    149149#endif 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/stpctl.F90

    r12377 r13159  
    2121   USE ice      , ONLY : vt_i, u_ice, tm_i 
    2222   ! 
     23   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    2324   USE in_out_manager  ! I/O manager 
    2425   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2526   USE lib_mpp         ! distributed memory computing 
    26  
     27   ! 
    2728   USE netcdf          ! NetCDF library 
    2829   IMPLICIT NONE 
     
    3132   PUBLIC stp_ctl           ! routine called by step.F90 
    3233 
    33    INTEGER  ::   idrun, idtime, idssh, idu, ids, istatus 
    34    LOGICAL  ::   lsomeoce 
     34   INTEGER                ::   nrunid   ! netcdf file id 
     35   INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    3839   !! Software governed by the CeCILL license (see ./LICENSE) 
    3940   !!---------------------------------------------------------------------- 
    40  
    4141CONTAINS 
    4242 
    43    SUBROUTINE stp_ctl( kt, kindic ) 
     43   SUBROUTINE stp_ctl( kt, Kmm ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                    ***  ROUTINE stp_ctl  *** 
     
    4949      !! ** Method  : - Save the time step in numstp 
    5050      !!              - Print it each 50 time steps 
     51      !!              - Stop the run IF problem encountered by setting nstop > 0 
     52      !!                Problems checked: ice thickness maximum > 100 m 
     53      !!                                  ice velocity  maximum > 10 m/s  
     54      !!                                  min ice temperature   < -100 degC 
    5155      !! 
    5256      !! ** Actions :   "time.step" file = last ocean time-step 
    5357      !!                "run.stat"  file = run statistics 
    54       !!                 
    55       !!---------------------------------------------------------------------- 
    56       INTEGER, INTENT( in    ) ::   kt       ! ocean time-step index 
    57       INTEGER, INTENT( inout ) ::   kindic   ! indicator of solver convergence 
    58       !! 
    59       REAL(wp), DIMENSION(3) ::   zmax 
    60       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    61       CHARACTER(len=20) :: clname 
    62       !!---------------------------------------------------------------------- 
    63       ! 
    64       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    65       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    66       ll_wrtruns = ll_colruns .AND. lwm 
    67       IF( kt == nit000 .AND. lwp ) THEN 
    68          WRITE(numout,*) 
    69          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    70          WRITE(numout,*) '~~~~~~~' 
    71          !                                ! open time.step file 
    72          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    73          !                                ! open run.stat file(s) at start whatever 
    74          !                                ! the value of sn_cfctl%ptimincr 
    75          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     58      !!                 nstop indicator sheared among all local domain 
     59      !!---------------------------------------------------------------------- 
     60      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     61      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     62      !! 
     63      INTEGER                         ::   ji                                    ! dummy loop indices 
     64      INTEGER                         ::   idtime, istatus 
     65      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
     66      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
     67      REAL(wp)                        ::   zzz                                   ! local real  
     68      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     69      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     70      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     71      CHARACTER(len=20)               ::   clname 
     72      !!---------------------------------------------------------------------- 
     73      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     74      ! 
     75      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     76      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     77      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     78      ! 
     79      IF( kt == nit000 ) THEN 
     80         ! 
     81         IF( lwp ) THEN 
     82            WRITE(numout,*) 
     83            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     84            WRITE(numout,*) '~~~~~~~' 
     85         ENDIF 
     86         !                                ! open time.step    ascii file, done only by 1st subdomain 
     87         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     88         ! 
     89         IF( ll_wrtruns ) THEN 
     90            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    7691            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     92            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    7793            clname = 'run.stat.nc' 
    7894            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    79             istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 
    80             istatus = NF90_DEF_DIM( idrun, 'time'     , NF90_UNLIMITED, idtime ) 
    81             istatus = NF90_DEF_VAR( idrun, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), idssh ) 
    82             istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 
    83             istatus = NF90_DEF_VAR( idrun, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), ids ) 
    84             istatus = NF90_ENDDEF(idrun) 
    85          ENDIF 
    86       ENDIF 
    87       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    88       ! 
    89       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     95            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     96            istatus = NF90_DEF_DIM( nrunid, 'time'     , NF90_UNLIMITED, idtime ) 
     97            istatus = NF90_DEF_VAR( nrunid, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     99            istatus = NF90_DEF_VAR( nrunid, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     100            istatus = NF90_ENDDEF(nrunid) 
     101         ENDIF 
     102         !     
     103      ENDIF 
     104      ! 
     105      !                                   !==              write current time step              ==! 
     106      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     107      IF( lwm .AND. ll_wrtstp ) THEN 
    90108         WRITE ( numstp, '(1x, i8)' )   kt 
    91109         REWIND( numstp ) 
    92110      ENDIF 
    93       !                                   !==  test of extrema  ==! 
     111      !                                   !==            test of local extrema           ==! 
     112      !                                   !==  done by all processes at every time step  ==! 
     113      llmsk(:,:) = tmask(:,:,1) == 1._wp 
     114      IF( COUNT( llmsk(:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     115         zmax(1) = MAXVAL(      vt_i (:,:)            , mask = llmsk )   ! max ice thickness 
     116         zmax(2) = MAXVAL( ABS( u_ice(:,:) )          , mask = llmsk )   ! max ice velocity (zonal only) 
     117         zmax(3) = MAXVAL(     -tm_i (:,:) + 273.15_wp, mask = llmsk )   ! min ice temperature 
     118      ELSE 
     119         IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     120            zmax(1:3) = -HUGE(1._wp) 
     121         ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     122            zmax(1:3) = 0._wp 
     123         ENDIF 
     124      ENDIF 
     125      zmax(4) = REAL( nstop, wp )                                     ! stop indicator 
     126      !                                   !==               get global extrema             ==! 
     127      !                                   !==  done by all processes if writting run.stat  ==! 
    94128      IF( ll_colruns ) THEN 
    95          zmax(1) = MAXVAL(      vt_i (:,:) )                                           ! max ice thickness 
    96          zmax(2) = MAXVAL( ABS( u_ice(:,:) ) )                                         ! max ice velocity (zonal only) 
    97          zmax(3) = MAXVAL(     -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp )   ! min ice temperature 
    98          CALL mpp_max( "stpctl", zmax )                                   ! max over the global domain 
     129         zmaxlocal(:) = zmax(:) 
     130         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
     131         nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     132      ENDIF 
     133      !                                   !==              write "run.stat" files              ==! 
     134      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     135      IF( ll_wrtruns ) THEN 
     136         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3) 
     137         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     138         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     139         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 
     140         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    99141      END IF 
    100       !                                            !==  run statistics  ==!   ("run.stat" file) 
    101       IF( ll_wrtruns ) THEN 
    102          WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 
    103          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    104          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    105          istatus = NF90_PUT_VAR( idrun,   ids, (/-zmax(3)/), (/kt/), (/1/) ) 
    106          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    107          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
    108       END IF 
     142      !                                   !==               error handling               ==! 
     143      !                                   !==  done by all processes at every time step  ==! 
     144      ! 
     145      IF(   zmax(1) >  100._wp .OR.   &                   ! too large ice thickness maximum ( > 100 m) 
     146         &  zmax(2) >   10._wp .OR.   &                   ! too large ice velocity ( > 10 m/s) 
     147         &  zmax(3) >  101._wp .OR.   &                   ! too cold ice temperature ( < -100 degC) 
     148         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     149         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     150         ! 
     151         iloc(:,:) = 0 
     152         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     153            ! first: close the netcdf file, so we can read it 
     154            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     155            ! get global loc on the min/max 
     156            CALL mpp_maxloc( 'stpctl',      vt_i(:,:)            , tmask(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     157            CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) )          , tmask(:,:,1), zzz, iloc(1:2,2) ) 
     158            CALL mpp_minloc( 'stpctl',      tm_i(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) ) 
     159            ! find which subdomain has the max. 
     160            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     161            DO ji = 1, 4 
     162               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     163                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     164               ENDIF 
     165            END DO 
     166            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     167            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     168            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     169         ELSE                    ! find local min and max locations: 
     170            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     171            iloc(1:2,1) = MAXLOC(       vt_i(:,:)            , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     172            iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )          , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     173            iloc(1:2,3) = MINLOC(       tm_i(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     174            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     175         ENDIF 
     176         ! 
     177         WRITE(ctmp1,*) ' stp_ctl: ice_thick > 100 m or |ice_vel| > 10 m/s or ice_temp < -100 degC or NaN encounter in the tests' 
     178         CALL wrt_line( ctmp2, kt, 'ice_thick max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     179         CALL wrt_line( ctmp3, kt, '|ice_vel| max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     180         CALL wrt_line( ctmp4, kt, 'ice_temp  min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     181         IF( Agrif_Root() ) THEN 
     182            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     183         ELSE 
     184            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     185         ENDIF 
     186         ! 
     187         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
     188         ! 
     189         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     190            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     191            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     192            ENDIF 
     193         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     194            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     195         ENDIF 
     196         ! 
     197      ENDIF 
     198      ! 
     199      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     200         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     201         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     202      ENDIF 
    109203      ! 
    1102049500  FORMAT(' it :', i8, '    vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 
    111205      ! 
    112206   END SUBROUTINE stp_ctl 
     207 
     208 
     209   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     210      !!---------------------------------------------------------------------- 
     211      !!                     ***  ROUTINE wrt_line  *** 
     212      !! 
     213      !! ** Purpose :   write information line 
     214      !! 
     215      !!---------------------------------------------------------------------- 
     216      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     217      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     218      REAL(wp),              INTENT(in   ) ::   pval 
     219      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     220      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     221      ! 
     222      CHARACTER(len=80) ::   clsuff 
     223      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     224      CHARACTER(len=9 ) ::   cli, clj, clk 
     225      CHARACTER(len=1 ) ::   clfmt 
     226      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     227      INTEGER           ::   ifmtk 
     228      !!---------------------------------------------------------------------- 
     229      WRITE(clkt , '(i9)') kt 
     230       
     231      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     232      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     233      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     234      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     235      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     236                                   WRITE(clmax, cl4) kmax-1 
     237      ! 
     238      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     239      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     240      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     241      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     242      ! 
     243      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     244      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     245      ENDIF 
     246      IF(kloc(3) == 0) THEN 
     247         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     248         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     249         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     250      ELSE 
     251         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     252         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     253         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     254         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     255      ENDIF 
     256      ! 
     2579100  FORMAT('MPI rank ', a) 
     2589200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2599300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2609400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     261      ! 
     262   END SUBROUTINE wrt_line 
     263 
    113264 
    114265   !!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P4Z/p4zmeso.F90

    r12377 r13159  
    6969      REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta 
    7070      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    71       REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
     71      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq  
     72      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    7273      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn 
    7374      REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof 
     
    156157         zgrazing2(ji,jj,jk) = zgraztotc 
    157158 
    158          !    Mesozooplankton efficiency 
    159          !    -------------------------- 
     159         ! Mesozooplankton efficiency.  
     160         ! We adopt a formulation proposed by Mitra et al. (2007) 
     161         ! The gross growth efficiency is controled by the most limiting nutrient. 
     162         ! Growth is also further decreased when the food quality is poor. This is currently 
     163         ! hard coded : it can be decreased by up to 50% (zepsherq) 
     164         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     165         ! Fulton, 2012) 
     166         ! ----------------------------------------------------------------------------------- 
    160167         zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
    161168         zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
     
    163170         zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    164171         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
    165          zepsherv  = zepsherf * zepshert  
     172         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
     173         zepsherv  = zepsherf * zepshert * zepsherq  
    166174 
    167175         zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
     
    170178         &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
    171179         zgrapoc2  = zgraztotc * unass2 
     180 
    172181 
    173182         !   Update the arrays TRA which contain the biological sources and sinks 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P4Z/p4zmicro.F90

    r12377 r13159  
    6767      REAL(wp) :: zgraze  , zdenom, zdenom2 
    6868      REAL(wp) :: zfact   , zfood, zfoodlim, zbeta 
    69       REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
     69      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq 
     70      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    7071      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    7172      REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn 
     
    119120         zgrazing(ji,jj,jk) = zgraztotc 
    120121 
    121          !    Various remineralization and excretion terms 
    122          !    -------------------------------------------- 
     122 
     123         ! Microzooplankton efficiency.  
     124         ! We adopt a formulation proposed by Mitra et al. (2007) 
     125         ! The gross growth efficiency is controled by the most limiting nutrient. 
     126         ! Growth is also further decreased when the food quality is poor. This is currently 
     127         ! hard coded : it can be decreased by up to 50% (zepsherq) 
     128         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     129         ! Fulton, 2012) 
     130         ! ----------------------------------------------------------------------------- 
    123131         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
    124132         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
     
    126134         zbeta     = MAX(0., (epsher - epshermin) ) 
    127135         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    128          zepsherv  = zepsherf * zepshert  
     136         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
     137         zepsherv  = zepsherf * zepshert * zepsherq  
    129138 
    130139         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P4Z/p4zsms.F90

    r12489 r13159  
    206206      IF( l_trdtrc ) THEN 
    207207         DO jn = jp_pcs0, jp_pcs1 
    208            ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r  
     208           ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr  
    209209           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    210210         END DO 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/SED/sedchem.F90

    r12377 r13159  
    577577         saltprac(:) = salt(:) * 35.0 / 35.16504 
    578578      ELSE 
    579          saltprac(:) = temp(:) 
     579         saltprac(:) = salt(:) 
    580580      ENDIF 
    581581 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/SED/sedinorg.F90

    r10225 r13159  
    8989            zsolcpcl = zsolcpcl + solcp(ji,jk,jsclay) * dz(jk) 
    9090         END DO 
     91         zsolcpsi = MAX( zsolcpsi, rtrn ) 
    9192         zsieq(ji) = sieqs(ji) * MAX(0.25, 1.0 - (0.045 * zsolcpcl / zsolcpsi )**0.58 ) 
    9293         zsieq(ji) = MAX( rtrn, sieqs(ji) ) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/SED/sedrst.F90

    r12489 r13159  
    8080         IF(lwp) WRITE(numsed,*) & 
    8181             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname 
    82          CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed ) 
     82         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 
    8383         lrst_sed = .TRUE. 
    8484      ENDIF 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/trcbc.F90

    r12489 r13159  
    151151               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  & 
    152152                   & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 
    153                IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
     153               IF(  .NOT.( 0 <= nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
    154154                   & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
    155155            END DO 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/trcstp.F90

    r12489 r13159  
    142142      ! 
    143143      ! Define logical parameter ton control dirunal cycle in TOP 
    144       l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    145       l_trcdm2dc = l_trcdm2dc  .AND. .NOT. l_offline 
     144      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 ) 
     145      l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline 
     146      ! 
    146147      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
    147148         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/stpctl.F90

    r12377 r13159  
    1919   USE dom_oce         ! ocean space and time domain variables  
    2020   USE c1d             ! 1D vertical configuration 
     21   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
     22   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
     23   !   
    2124   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2325   USE in_out_manager  ! I/O manager 
    2426   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2527   USE lib_mpp         ! distributed memory computing 
    26    USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    27    USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    28  
     28   ! 
    2929   USE netcdf          ! NetCDF library 
    3030   IMPLICIT NONE 
     
    3333   PUBLIC stp_ctl           ! routine called by step.F90 
    3434 
    35    INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 
    36    LOGICAL  ::   lsomeoce 
     35   INTEGER                ::   nrunid   ! netcdf file id 
     36   INTEGER, DIMENSION(8)  ::   nvarid   ! netcdf variable id 
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4242CONTAINS 
    4343 
    44    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     44   SUBROUTINE stp_ctl( kt, Kmm ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                    ***  ROUTINE stp_ctl  *** 
     
    5050      !! ** Method  : - Save the time step in numstp 
    5151      !!              - Print it each 50 time steps 
    52       !!              - Stop the run IF problem encountered by setting indic=-3 
     52      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5353      !!                Problems checked: |ssh| maximum larger than 10 m 
    5454      !!                                  |U|   maximum larger than 10 m/s  
     
    5757      !! ** Actions :   "time.step" file = last ocean time-step 
    5858      !!                "run.stat"  file = run statistics 
    59       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     59      !!                 nstop indicator sheared among all local domain 
    6060      !!---------------------------------------------------------------------- 
    6161      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    62       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    63       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    64       !! 
    65       INTEGER                ::   ji, jj, jk          ! dummy loop indices 
    66       INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
    67       INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
    68       REAL(wp)               ::   zzz                 ! local real  
    69       REAL(wp), DIMENSION(9) ::   zmax 
    70       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    71       CHARACTER(len=20) :: clname 
    72       !!---------------------------------------------------------------------- 
    73       ! 
    74       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    75       ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 
    76       ll_wrtruns = ll_colruns .AND. lwm 
    77       IF( kt == nit000 .AND. lwp ) THEN 
    78          WRITE(numout,*) 
    79          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    80          WRITE(numout,*) '~~~~~~~' 
    81          !                                ! open time.step file 
    82          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    83          !                                ! open run.stat file(s) at start whatever 
    84          !                                ! the value of sn_cfctl%ptimincr 
    85          IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 
     62      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     63      !! 
     64      INTEGER                         ::   ji                                    ! dummy loop indices 
     65      INTEGER                         ::   idtime, istatus 
     66      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax 
     67      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
     68      REAL(wp)                        ::   zzz                                   ! local real  
     69      REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal 
     70      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     71      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
     72      CHARACTER(len=20)               ::   clname 
     73      !!---------------------------------------------------------------------- 
     74      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     75      ! 
     76      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     77      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     78      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     79      ! 
     80      IF( kt == nit000 ) THEN 
     81         ! 
     82         IF( lwp ) THEN 
     83            WRITE(numout,*) 
     84            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     85            WRITE(numout,*) '~~~~~~~' 
     86         ENDIF 
     87         !                                ! open time.step    ascii file, done only by 1st subdomain 
     88         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     89         ! 
     90         IF( ll_wrtruns ) THEN 
     91            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    8692            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     93            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    8794            clname = 'run.stat.nc' 
    8895            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    89             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    90             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    91             istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 
    92             istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu  ) 
    93             istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1 ) 
    94             istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2 ) 
    95             istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1 ) 
    96             istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2 ) 
     96            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     97            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     99            istatus = NF90_DEF_VAR( nrunid,   'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     100            istatus = NF90_DEF_VAR( nrunid,       's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     101            istatus = NF90_DEF_VAR( nrunid,       's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 
     102            istatus = NF90_DEF_VAR( nrunid,       't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 
     103            istatus = NF90_DEF_VAR( nrunid,       't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 
    97104            IF( ln_zad_Aimp ) THEN 
    98                istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1 ) 
    99                istatus = NF90_DEF_VAR( idrun,       'Cu_max', NF90_DOUBLE, (/ idtime /), idc1 ) 
     105               istatus = NF90_DEF_VAR( nrunid,   'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 
     106               istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 
    100107            ENDIF 
    101             istatus = NF90_ENDDEF(idrun) 
    102             zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use 
    103          ENDIF 
    104       ENDIF 
    105       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    106       ! 
    107       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     108            istatus = NF90_ENDDEF(nrunid) 
     109         ENDIF 
     110         !     
     111      ENDIF 
     112      ! 
     113      !                                   !==              write current time step              ==! 
     114      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     115      IF( lwm .AND. ll_wrtstp ) THEN 
    108116         WRITE ( numstp, '(1x, i8)' )   kt 
    109117         REWIND( numstp ) 
    110118      ENDIF 
    111       ! 
    112       !                                   !==  test of extrema  ==! 
    113       IF( ll_wd ) THEN 
    114          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
    115       ELSE 
    116          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max 
    117       ENDIF 
    118       zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only) 
    119       zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
    120       zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
    121       zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
    122       zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
    123       zmax(7) = REAL( nstop , wp )                                            ! stop indicator 
    124       IF( ln_zad_Aimp ) THEN 
    125          zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 
    126          zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) !       cell Courant no. max 
    127       ENDIF 
    128       ! 
     119      !                                   !==            test of local extrema           ==! 
     120      !                                   !==  done by all processes at every time step  ==! 
     121      ! 
     122      ! define zmax default value. needed for land processors 
     123      IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     124         zmax(:) = -HUGE(1._wp) 
     125      ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     126         zmax(:) =  0._wp 
     127         zmax(3) = -1._wp      ! avoid salinity minimum at 0. 
     128      ENDIF 
     129      ! 
     130      llmsk(:,:,1) = ssmask(:,:) == 1._wp 
     131      IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     132         IF( ll_wd ) THEN 
     133            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     134         ELSE 
     135            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
     136         ENDIF 
     137      ENDIF 
     138      zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) )                                       ! velocity max (zonal only) 
     139      llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
     140      IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     141         zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
     142         zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     143         IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
     144            zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
     145            zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     146            IF( ln_zad_Aimp ) THEN 
     147               zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
     148               llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
     149               IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     150                  zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk )                  ! implicit vertical vel. max 
     151               ENDIF 
     152            ENDIF 
     153         ENDIF 
     154      ENDIF 
     155      zmax(9) = REAL( nstop, wp )                                              ! stop indicator 
     156      !                                   !==               get global extrema             ==! 
     157      !                                   !==  done by all processes if writting run.stat  ==! 
    129158      IF( ll_colruns ) THEN 
     159         zmaxlocal(:) = zmax(:) 
    130160         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    131          nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains 
    132       ENDIF 
    133       !                                   !==  run statistics  ==!   ("run.stat" files) 
     161         nstop = NINT( zmax(9) )                 ! update nstop indicator (now sheared among all local domains) 
     162      ENDIF 
     163      !                                   !==              write "run.stat" files              ==! 
     164      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    134165      IF( ll_wrtruns ) THEN 
    135166         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    136          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    137          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    138          istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) ) 
    139          istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) ) 
    140          istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) ) 
    141          istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) ) 
     167         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     168         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     169         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 
     170         istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 
     171         istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 
     172         istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 
    142173         IF( ln_zad_Aimp ) THEN 
    143             istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) ) 
    144             istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) ) 
    145          ENDIF 
    146          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    147          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     174            istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 
     175            istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 
     176         ENDIF 
     177         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    148178      END IF 
    149       !                                   !==  error handling  ==! 
    150       IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 
    151          &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m ) 
    152          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
    153 !!$      &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
    154 !!$      &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
    155 !!$      &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
    156          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    157          IF( lk_mpp .AND. ln_ctl ) THEN 
    158             CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  ) 
    159             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  ) 
    160             CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 
    161             CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 
     179      !                                   !==               error handling               ==! 
     180      !                                   !==  done by all processes at every time step  ==! 
     181      ! 
     182      IF(   zmax(1) >   20._wp .OR.   &                   ! too large sea surface height ( > 20 m ) 
     183         &  zmax(2) >   10._wp .OR.   &                   ! too large velocity ( > 10 m/s) 
     184!!$         &  zmax(3) >=   0._wp .OR.   &                   ! negative or zero sea surface salinity 
     185!!$         &  zmax(4) >= 100._wp .OR.   &                   ! too large sea surface salinity ( > 100 ) 
     186!!$         &  zmax(4) <    0._wp .OR.   &                   ! too large sea surface salinity (keep this line for sea-ice) 
     187         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     188         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     189         ! 
     190         iloc(:,:) = 0 
     191         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     192            ! first: close the netcdf file, so we can read it 
     193            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     194            ! get global loc on the min/max 
     195            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     196            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)),  umask(:,:,:), zzz, iloc(1:3,2) ) 
     197            CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,3) ) 
     198            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,4) ) 
     199            ! find which subdomain has the max. 
     200            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     201            DO ji = 1, 9 
     202               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     203                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     204               ENDIF 
     205            END DO 
     206            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     207            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     208            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     209         ELSE                    ! find local min and max locations: 
     210            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     211            iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
     212            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     213            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     214            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     215            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     216         ENDIF 
     217         ! 
     218         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
     219         CALL wrt_line( ctmp2, kt, '|ssh| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     220         CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     221         CALL wrt_line( ctmp4, kt, 'Sal   min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     222         CALL wrt_line( ctmp5, kt, 'Sal   max',  zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 
     223         IF( Agrif_Root() ) THEN 
     224            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    162225         ELSE 
    163             ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
    164             iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    165             is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    166             is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    167          ENDIF 
    168           
    169          WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    170          WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2) 
    171          WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    172          WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
    173          WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
    174          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    175           
     226            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     227         ENDIF 
     228         ! 
    176229         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    177           
    178          IF( .NOT. ln_ctl ) THEN 
    179             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    180             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 ) 
    181          ELSE 
    182             CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' ) 
    183          ENDIF 
    184  
    185          kindic = -3 
    186          ! 
    187       ENDIF 
    188       ! 
    189 9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
    190 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    191 9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
    192 9400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
     230         ! 
     231         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     232            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     233            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     234            ENDIF 
     235         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     236            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     237         ENDIF 
     238         ! 
     239      ENDIF 
     240      ! 
     241      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     242         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     243         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     244      ENDIF 
     245      ! 
    1932469500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    194247      ! 
    195248   END SUBROUTINE stp_ctl 
     249 
     250 
     251   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     252      !!---------------------------------------------------------------------- 
     253      !!                     ***  ROUTINE wrt_line  *** 
     254      !! 
     255      !! ** Purpose :   write information line 
     256      !! 
     257      !!---------------------------------------------------------------------- 
     258      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     259      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     260      REAL(wp),              INTENT(in   ) ::   pval 
     261      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     262      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     263      ! 
     264      CHARACTER(len=80) ::   clsuff 
     265      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     266      CHARACTER(len=9 ) ::   cli, clj, clk 
     267      CHARACTER(len=1 ) ::   clfmt 
     268      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     269      INTEGER           ::   ifmtk 
     270      !!---------------------------------------------------------------------- 
     271      WRITE(clkt , '(i9)') kt 
     272       
     273      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     274      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     275      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     276      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     277      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     278                                   WRITE(clmax, cl4) kmax-1 
     279      ! 
     280      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     281      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     282      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     283      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     284      ! 
     285      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     286      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     287      ENDIF 
     288      IF(kloc(3) == 0) THEN 
     289         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     290         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     291         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     292      ELSE 
     293         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     294         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     295         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     296         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     297      ENDIF 
     298      ! 
     2999100  FORMAT('MPI rank ', a) 
     3009200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     3019300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     3029400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     303      ! 
     304   END SUBROUTINE wrt_line 
     305 
    196306 
    197307   !!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml

    r11889 r13159  
    2121      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
    2222 
    23       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
    24    <file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" > 
    25      <field field_ref="toce"         name="votemper"  /> 
    26      <field field_ref="soce"         name="vosaline"  /> 
    27      <field field_ref="ssh"          name="sossheig"  /> 
     23   <file id="file1" output_freq="5d" name_suffix="_grid_T" description="ocean T grid variables" > 
     24     <field field_ref="toce"         name="votemper"  operation="average" freq_op="5d" > @toce_e3t / @e3t </field> 
     25     <field field_ref="soce"         name="vosaline"  operation="average" freq_op="5d" > @soce_e3t / @e3t </field> 
     26     <field field_ref="ssh"          name="sossheig" /> 
    2827          <!-- variable for ice shelf --> 
    29           <field field_ref="fwfisf_cav"       name="sowflisf"  /> 
    30           <field field_ref="isfgammat"    name="sogammat"  /> 
    31           <field field_ref="isfgammas"    name="sogammas"  /> 
     28          <field field_ref="fwfisf_cav"  name="sowflisf"  /> 
     29          <field field_ref="isfgammat"   name="sogammat"  /> 
     30          <field field_ref="isfgammas"   name="sogammas"  /> 
    3231          <field field_ref="ttbl_cav"    name="ttbl"  /> 
    33           <field field_ref="stbl"    name="stbl"  /> 
    34           <field field_ref="utbl"    name="utbl"  /> 
    35           <field field_ref="vtbl"    name="vtbl"  /> 
     32          <field field_ref="stbl"        name="stbl"  /> 
     33          <field field_ref="utbl"        name="utbl"  /> 
     34          <field field_ref="vtbl"        name="vtbl"  /> 
    3635        </file> 
    37    <file id="file2" output_freq="1mo" name_suffix="_grid_U" description="ocean U grid variables" > 
    38           <field field_ref="uoce"         name="vozocrtx" /> 
     36   <file id="file2" output_freq="5d" name_suffix="_grid_U" description="ocean U grid variables" > 
     37          <field field_ref="uoce"         name="vozocrtx" operation="average" freq_op="5d" > @uoce_e3u / @e3u </field> /> 
    3938        </file> 
    40    <file id="file3" output_freq="1mo" name_suffix="_grid_V" description="ocean V grid variables" > 
    41           <field field_ref="voce"         name="vomecrty" />  
     39   <file id="file3" output_freq="5d" name_suffix="_grid_V" description="ocean V grid variables" > 
     40          <field field_ref="voce"         name="vomecrty" operation="average" freq_op="5d" > @voce_e3v / @e3v </field> />  
    4241        </file> 
    4342      </file_group> 
     43 
     44      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
    4445      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
    4546      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/EXPREF/namelist_cfg

    r12489 r13159  
    114114 
    115115   ln_usr      = .true.   !  user defined formulation                  (T => check usrdef_sbc) 
    116    nn_fwb      = 1 
     116   nn_fwb      = 4 
    117117/ 
    118118!----------------------------------------------------------------------- 
     
    308308&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    309309!----------------------------------------------------------------------- 
    310    ln_teos10   = .false.         !  = Use TEOS-10 
    311    ln_eos80    = .false.         !  = Use EOS80 
    312    ln_leos     = .true.          !  = Use S-EOS (simplified Eq.) 
     310   ln_leos     = .true.          !  = Use L-EOS (linear Eq.) 
    313311                                 ! 
    314312   !                     ! S-EOS coefficients (ln_seos=T): 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/dtatsd.F90

    r12077 r13159  
    3636   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsddmp ! structure of input SST (file informations, fields read) 
    3737 
     38   !! * Substitutions 
     39#  include "do_loop_substitute.h90" 
    3840   !!---------------------------------------------------------------------- 
    3941   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6769      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
    6870      ! 
    69       REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
    7071      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
    7172901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist' ) 
    72       REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run 
    7373      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
    7474902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist' ) 
     
    191191         ENDIF 
    192192         ! 
    193          DO jj = 1, jpj                         ! vertical interpolation of T & S 
    194             DO ji = 1, jpi 
    195                DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    196                   zl = gdept_0(ji,jj,jk) 
    197                   IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data 
    198                      ztp(jk) =  ptsd(ji,jj,1    ,jp_tem) 
    199                      zsp(jk) =  ptsd(ji,jj,1    ,jp_sal) 
    200                   ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data 
    201                      ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem) 
    202                      zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal) 
    203                   ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    204                      DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    205                         IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    206                            zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    207                            ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
    208                            zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
    209                         ENDIF 
    210                      END DO 
    211                   ENDIF 
    212                END DO 
    213                DO jk = 1, jpkm1 
    214                   ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    215                   ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 
    216                END DO 
    217                ptsd(ji,jj,jpk,jp_tem) = 0._wp 
    218                ptsd(ji,jj,jpk,jp_sal) = 0._wp 
     193         DO_2D_11_11 
     194            DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     195               zl = gdept_0(ji,jj,jk) 
     196               IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data 
     197                  ztp(jk) =  ptsd(ji,jj,1    ,jp_tem) 
     198                  zsp(jk) =  ptsd(ji,jj,1    ,jp_sal) 
     199               ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data 
     200                  ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem) 
     201                  zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal) 
     202               ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     203                  DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     204                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     205                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     206                        ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
     207                        zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
     208                     ENDIF 
     209                  END DO 
     210               ENDIF 
    219211            END DO 
    220          END DO 
     212            DO jk = 1, jpkm1 
     213               ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     214               ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 
     215            END DO 
     216            ptsd(ji,jj,jpk,jp_tem) = 0._wp 
     217            ptsd(ji,jj,jpk,jp_sal) = 0._wp 
     218         END_2D 
    221219         !  
    222220      ELSE                                !==   z- or zps- coordinate   ==! 
     
    226224         ! 
    227225         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    228             DO jj = 1, jpj 
    229                DO ji = 1, jpi 
    230                   ik = mbkt(ji,jj)  
    231                   IF( ik > 1 ) THEN 
    232                      zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    233                      ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 
    234                      ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 
    235                   ENDIF 
    236                   ik = mikt(ji,jj) 
    237                   IF( ik > 1 ) THEN 
    238                      zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )  
    239                      ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 
    240                      ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 
    241                   END IF 
    242                END DO 
    243             END DO 
     226            DO_2D_11_11 
     227               ik = mbkt(ji,jj)  
     228               IF( ik > 1 ) THEN 
     229                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     230                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 
     231                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 
     232               ENDIF 
     233               ik = mikt(ji,jj) 
     234               IF( ik > 1 ) THEN 
     235                  zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )  
     236                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 
     237                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 
     238               END IF 
     239            END_2D 
    244240         ENDIF 
    245241         ! 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/eosbn2.F90

    r12489 r13159  
    180180   REAL(wp) ::   BPE002 
    181181 
     182   !! * Substitutions 
     183#  include "do_loop_substitute.h90" 
    182184   !!---------------------------------------------------------------------- 
    183185   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    241243      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    242244         ! 
    243          DO jk = 1, jpkm1 
    244             DO jj = 1, jpj 
    245                DO ji = 1, jpi 
    246                   ! 
    247                   zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    248                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    249                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    250                   ztm = tmask(ji,jj,jk)                                         ! tmask 
     245         DO_3D_11_11( 1, jpkm1 ) 
     246            ! 
     247            zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     248            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     249            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     250            ztm = tmask(ji,jj,jk)                                         ! tmask 
     251            ! 
     252            zn3 = EOS013*zt   & 
     253               &   + EOS103*zs+EOS003 
     254               ! 
     255            zn2 = (EOS022*zt   & 
     256               &   + EOS112*zs+EOS012)*zt   & 
     257               &   + (EOS202*zs+EOS102)*zs+EOS002 
     258               ! 
     259            zn1 = (((EOS041*zt   & 
     260               &   + EOS131*zs+EOS031)*zt   & 
     261               &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     262               &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     263               &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     264               ! 
     265            zn0 = (((((EOS060*zt   & 
     266               &   + EOS150*zs+EOS050)*zt   & 
     267               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     268               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     269               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     270               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     271               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     272               ! 
     273            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     274            ! 
     275            prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked) 
     276            ! 
     277         END_3D 
     278         ! 
     279      CASE( np_seos )                !==  simplified EOS  ==! 
     280         ! 
     281         DO_3D_11_11( 1, jpkm1 ) 
     282            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     283            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     284            zh  = pdep (ji,jj,jk) 
     285            ztm = tmask(ji,jj,jk) 
     286            ! 
     287            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     288               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     289               &  - rn_nu * zt * zs 
     290               !                                  
     291            prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
     292         END_3D 
     293         ! 
     294      CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
     295         ! 
     296         DO_3D_11_11( 1, jpkm1 ) 
     297            zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
     298            zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
     299            zh  = pdep (ji,jj,jk) 
     300            ztm = tmask(ji,jj,jk) 
     301            ! 
     302            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     303            !                                  
     304            prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
     305         END_3D 
     306         ! 
     307      END SELECT 
     308      ! 
     309      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', kdim=jpk ) 
     310      ! 
     311      IF( ln_timing )   CALL timing_stop('eos-insitu') 
     312      ! 
     313   END SUBROUTINE eos_insitu 
     314 
     315 
     316   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
     317      !!---------------------------------------------------------------------- 
     318      !!                  ***  ROUTINE eos_insitu_pot  *** 
     319      !! 
     320      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
     321      !!      potential volumic mass (Kg/m3) from potential temperature and 
     322      !!      salinity fields using an equation of state selected in the 
     323      !!     namelist. 
     324      !! 
     325      !! ** Action  : - prd  , the in situ density (no units) 
     326      !!              - prhop, the potential volumic mass (Kg/m3) 
     327      !! 
     328      !!---------------------------------------------------------------------- 
     329      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     330      !                                                                ! 2 : salinity               [psu] 
     331      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
     332      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     333      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
     334      ! 
     335      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     336      INTEGER  ::   jdof 
     337      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     338      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     339      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
     340      !!---------------------------------------------------------------------- 
     341      ! 
     342      IF( ln_timing )   CALL timing_start('eos-pot') 
     343      ! 
     344      SELECT CASE ( neos ) 
     345      ! 
     346      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     347         ! 
     348         ! Stochastic equation of state 
     349         IF ( ln_sto_eos ) THEN 
     350            ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
     351            ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
     352            ALLOCATE(zsign(1:2*nn_sto_eos)) 
     353            DO jsmp = 1, 2*nn_sto_eos, 2 
     354              zsign(jsmp)   = 1._wp 
     355              zsign(jsmp+1) = -1._wp 
     356            END DO 
     357            ! 
     358            DO_3D_11_11( 1, jpkm1 ) 
     359               ! 
     360               ! compute density (2*nn_sto_eos) times: 
     361               ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
     362               ! (2) for t-dt, s-ds (with the opposite fluctuation) 
     363               DO jsmp = 1, nn_sto_eos*2 
     364                  jdof   = (jsmp + 1) / 2 
     365                  zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     366                  zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
     367                  zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
     368                  zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
     369                  ztm    = tmask(ji,jj,jk)                                         ! tmask 
    251370                  ! 
    252371                  zn3 = EOS013*zt   & 
     
    263382                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    264383                     ! 
    265                   zn0 = (((((EOS060*zt   & 
     384                  zn0_sto(jsmp) = (((((EOS060*zt   & 
    266385                     &   + EOS150*zs+EOS050)*zt   & 
    267386                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     
    271390                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    272391                     ! 
    273                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     392                  zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
     393               END DO 
     394               ! 
     395               ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
     396               prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
     397               DO jsmp = 1, nn_sto_eos*2 
     398                  prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
    274399                  ! 
    275                   prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked) 
    276                   ! 
     400                  prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked) 
    277401               END DO 
    278             END DO 
    279          END DO 
    280          ! 
    281       CASE( np_seos )                !==  simplified EOS  ==! 
    282          ! 
    283          DO jk = 1, jpkm1 
    284             DO jj = 1, jpj 
    285                DO ji = 1, jpi 
    286                   zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    287                   zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    288                   zh  = pdep (ji,jj,jk) 
    289                   ztm = tmask(ji,jj,jk) 
    290                   ! 
    291                   zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
    292                      &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
    293                      &  - rn_nu * zt * zs 
    294                      !                                  
    295                   prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    296                END DO 
    297             END DO 
    298          END DO 
    299          ! 
    300       CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
    301          ! 
    302          DO jk = 1, jpkm1 
    303             DO jj = 1, jpj 
    304                DO ji = 1, jpi 
    305                   zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
    306                   zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
    307                   zh  = pdep (ji,jj,jk) 
    308                   ztm = tmask(ji,jj,jk) 
    309                   ! 
    310                   zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
    311                   !                                  
    312                   prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    313                END DO 
    314             END DO 
    315          END DO 
    316          ! 
    317       END SELECT 
    318       ! 
    319       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', kdim=jpk ) 
    320       ! 
    321       IF( ln_timing )   CALL timing_stop('eos-insitu') 
    322       ! 
    323    END SUBROUTINE eos_insitu 
    324  
    325  
    326    SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
    327       !!---------------------------------------------------------------------- 
    328       !!                  ***  ROUTINE eos_insitu_pot  *** 
    329       !! 
    330       !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
    331       !!      potential volumic mass (Kg/m3) from potential temperature and 
    332       !!      salinity fields using an equation of state selected in the 
    333       !!     namelist. 
    334       !! 
    335       !! ** Action  : - prd  , the in situ density (no units) 
    336       !!              - prhop, the potential volumic mass (Kg/m3) 
    337       !! 
    338       !!---------------------------------------------------------------------- 
    339       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    340       !                                                                ! 2 : salinity               [psu] 
    341       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    342       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    343       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    344       ! 
    345       INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    346       INTEGER  ::   jdof 
    347       REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
    348       REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
    349       REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
    350       !!---------------------------------------------------------------------- 
    351       ! 
    352       IF( ln_timing )   CALL timing_start('eos-pot') 
    353       ! 
    354       SELECT CASE ( neos ) 
    355       ! 
    356       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    357          ! 
    358          ! Stochastic equation of state 
    359          IF ( ln_sto_eos ) THEN 
    360             ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
    361             ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
    362             ALLOCATE(zsign(1:2*nn_sto_eos)) 
    363             DO jsmp = 1, 2*nn_sto_eos, 2 
    364               zsign(jsmp)   = 1._wp 
    365               zsign(jsmp+1) = -1._wp 
    366             END DO 
    367             ! 
    368             DO jk = 1, jpkm1 
    369                DO jj = 1, jpj 
    370                   DO ji = 1, jpi 
    371                      ! 
    372                      ! compute density (2*nn_sto_eos) times: 
    373                      ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
    374                      ! (2) for t-dt, s-ds (with the opposite fluctuation) 
    375                      DO jsmp = 1, nn_sto_eos*2 
    376                         jdof   = (jsmp + 1) / 2 
    377                         zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    378                         zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
    379                         zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
    380                         zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
    381                         ztm    = tmask(ji,jj,jk)                                         ! tmask 
    382                         ! 
    383                         zn3 = EOS013*zt   & 
    384                            &   + EOS103*zs+EOS003 
    385                            ! 
    386                         zn2 = (EOS022*zt   & 
    387                            &   + EOS112*zs+EOS012)*zt   & 
    388                            &   + (EOS202*zs+EOS102)*zs+EOS002 
    389                            ! 
    390                         zn1 = (((EOS041*zt   & 
    391                            &   + EOS131*zs+EOS031)*zt   & 
    392                            &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    393                            &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    394                            &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    395                            ! 
    396                         zn0_sto(jsmp) = (((((EOS060*zt   & 
    397                            &   + EOS150*zs+EOS050)*zt   & 
    398                            &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    399                            &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    400                            &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    401                            &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    402                            &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    403                            ! 
    404                         zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
    405                      END DO 
    406                      ! 
    407                      ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
    408                      prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
    409                      DO jsmp = 1, nn_sto_eos*2 
    410                         prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
    411                         ! 
    412                         prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked) 
    413                      END DO 
    414                      prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
    415                      prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
    416                   END DO 
    417                END DO 
    418             END DO 
     402               prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
     403               prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
     404            END_3D 
    419405            DEALLOCATE(zn0_sto,zn_sto,zsign) 
    420406         ! Non-stochastic equation of state 
    421407         ELSE 
    422             DO jk = 1, jpkm1 
    423                DO jj = 1, jpj 
    424                   DO ji = 1, jpi 
    425                      ! 
    426                      zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    427                      zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    428                      zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    429                      ztm = tmask(ji,jj,jk)                                         ! tmask 
    430                      ! 
    431                      zn3 = EOS013*zt   & 
    432                         &   + EOS103*zs+EOS003 
    433                         ! 
    434                      zn2 = (EOS022*zt   & 
    435                         &   + EOS112*zs+EOS012)*zt   & 
    436                         &   + (EOS202*zs+EOS102)*zs+EOS002 
    437                         ! 
    438                      zn1 = (((EOS041*zt   & 
    439                         &   + EOS131*zs+EOS031)*zt   & 
    440                         &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    441                         &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    442                         &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    443                         ! 
    444                      zn0 = (((((EOS060*zt   & 
    445                         &   + EOS150*zs+EOS050)*zt   & 
    446                         &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    447                         &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    448                         &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    449                         &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    450                         &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    451                         ! 
    452                      zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    453                      ! 
    454                      prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
    455                      ! 
    456                      prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    457                   END DO 
    458                END DO 
    459             END DO 
    460          ENDIF 
    461           
    462       CASE( np_seos )                !==  simplified EOS  ==! 
    463          ! 
    464          DO jk = 1, jpkm1 
    465             DO jj = 1, jpj 
    466                DO ji = 1, jpi 
    467                   zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    468                   zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    469                   zh  = pdep (ji,jj,jk) 
    470                   ztm = tmask(ji,jj,jk) 
    471                   !                                                     ! potential density referenced at the surface 
    472                   zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
    473                      &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
    474                      &  - rn_nu * zt * zs 
    475                   prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
    476                   !                                                     ! density anomaly (masked) 
    477                   zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
    478                   prd(ji,jj,jk) = zn * r1_rho0 * ztm 
    479                   ! 
    480                END DO 
    481             END DO 
    482          END DO 
    483          ! 
    484       CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
    485          ! 
    486          DO jk = 1, jpkm1 
    487             DO jj = 1, jpj 
    488                DO ji = 1, jpi 
    489                   zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
    490                   zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
    491                   zh  = pdep (ji,jj,jk) 
    492                   ztm = tmask(ji,jj,jk) 
    493                   !                                                     ! potential density referenced at the surface 
    494                   zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
    495                   prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
    496                   !                                                     ! density anomaly (masked) 
    497                   prd(ji,jj,jk) = zn * r1_rho0 * ztm 
    498                   ! 
    499                END DO 
    500             END DO 
    501          END DO 
    502          ! 
    503       END SELECT 
    504       ! 
    505       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
    506       ! 
    507       IF( ln_timing )   CALL timing_stop('eos-pot') 
    508       ! 
    509    END SUBROUTINE eos_insitu_pot 
    510  
    511  
    512    SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
    513       !!---------------------------------------------------------------------- 
    514       !!                  ***  ROUTINE eos_insitu_2d  *** 
    515       !! 
    516       !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
    517       !!      potential temperature and salinity using an equation of state 
    518       !!      selected in the nameos namelist. * 2D field case 
    519       !! 
    520       !! ** Action  : - prd , the in situ density (no units) (unmasked) 
    521       !! 
    522       !!---------------------------------------------------------------------- 
    523       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    524       !                                                           ! 2 : salinity               [psu] 
    525       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    526       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
    527       ! 
    528       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    529       REAL(wp) ::   zt , zh , zs              ! local scalars 
    530       REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
    531       !!---------------------------------------------------------------------- 
    532       ! 
    533       IF( ln_timing )   CALL timing_start('eos2d') 
    534       ! 
    535       prd(:,:) = 0._wp 
    536       ! 
    537       SELECT CASE( neos ) 
    538       ! 
    539       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    540          ! 
    541          DO jj = 1, jpjm1 
    542             DO ji = 1, fs_jpim1   ! vector opt. 
    543                ! 
    544                zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
    545                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
    546                zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     408            DO_3D_11_11( 1, jpkm1 ) 
     409               ! 
     410               zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     411               zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     412               zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     413               ztm = tmask(ji,jj,jk)                                         ! tmask 
    547414               ! 
    548415               zn3 = EOS013*zt   & 
     
    569436               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    570437               ! 
    571                prd(ji,jj) = zn * r1_rho0 - 1._wp               ! unmasked in situ density anomaly 
    572                ! 
    573             END DO 
    574          END DO 
    575          ! 
    576          CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions 
    577          ! 
     438               prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     439               ! 
     440               prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     441            END_3D 
     442         ENDIF 
     443          
    578444      CASE( np_seos )                !==  simplified EOS  ==! 
    579445         ! 
    580          DO jj = 1, jpjm1 
    581             DO ji = 1, fs_jpim1   ! vector opt. 
    582                ! 
    583                zt    = pts  (ji,jj,jp_tem)  - 10._wp 
    584                zs    = pts  (ji,jj,jp_sal)  - 35._wp 
    585                zh    = pdep (ji,jj)                         ! depth at the partial step level 
    586                ! 
    587                zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
    588                   &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
    589                   &  - rn_nu * zt * zs 
    590                   ! 
    591                prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
    592                ! 
    593             END DO 
    594          END DO 
    595          ! 
    596          CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions 
     446         DO_3D_11_11( 1, jpkm1 ) 
     447            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     448            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     449            zh  = pdep (ji,jj,jk) 
     450            ztm = tmask(ji,jj,jk) 
     451            !                                                     ! potential density referenced at the surface 
     452            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     453               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     454               &  - rn_nu * zt * zs 
     455            prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
     456            !                                                     ! density anomaly (masked) 
     457            zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
     458            prd(ji,jj,jk) = zn * r1_rho0 * ztm 
     459            ! 
     460         END_3D 
     461         ! 
     462      CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
     463         ! 
     464         DO_3D_11_11( 1, jpkm1 ) 
     465            zt  = pts  (ji,jj,jk,jp_tem) - (-1._wp) 
     466            zs  = pts  (ji,jj,jk,jp_sal) - 34.2_wp 
     467            zh  = pdep (ji,jj,jk) 
     468            ztm = tmask(ji,jj,jk) 
     469            !                                                     ! potential density referenced at the surface 
     470            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     471            prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
     472            !                                                     ! density anomaly (masked) 
     473            prd(ji,jj,jk) = zn * r1_rho0 * ztm 
     474            ! 
     475         END_3D 
     476         ! 
     477      END SELECT 
     478      ! 
     479      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
     480      ! 
     481      IF( ln_timing )   CALL timing_stop('eos-pot') 
     482      ! 
     483   END SUBROUTINE eos_insitu_pot 
     484 
     485 
     486   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
     487      !!---------------------------------------------------------------------- 
     488      !!                  ***  ROUTINE eos_insitu_2d  *** 
     489      !! 
     490      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
     491      !!      potential temperature and salinity using an equation of state 
     492      !!      selected in the nameos namelist. * 2D field case 
     493      !! 
     494      !! ** Action  : - prd , the in situ density (no units) (unmasked) 
     495      !! 
     496      !!---------------------------------------------------------------------- 
     497      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     498      !                                                           ! 2 : salinity               [psu] 
     499      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
     500      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
     501      ! 
     502      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     503      REAL(wp) ::   zt , zh , zs              ! local scalars 
     504      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     505      !!---------------------------------------------------------------------- 
     506      ! 
     507      IF( ln_timing )   CALL timing_start('eos2d') 
     508      ! 
     509      prd(:,:) = 0._wp 
     510      ! 
     511      SELECT CASE( neos ) 
     512      ! 
     513      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     514         ! 
     515         DO_2D_11_11 
     516            ! 
     517            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     518            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     519            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     520            ! 
     521            zn3 = EOS013*zt   & 
     522               &   + EOS103*zs+EOS003 
     523               ! 
     524            zn2 = (EOS022*zt   & 
     525               &   + EOS112*zs+EOS012)*zt   & 
     526               &   + (EOS202*zs+EOS102)*zs+EOS002 
     527               ! 
     528            zn1 = (((EOS041*zt   & 
     529               &   + EOS131*zs+EOS031)*zt   & 
     530               &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     531               &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     532               &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     533               ! 
     534            zn0 = (((((EOS060*zt   & 
     535               &   + EOS150*zs+EOS050)*zt   & 
     536               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     537               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     538               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     539               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     540               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     541               ! 
     542            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     543            ! 
     544            prd(ji,jj) = zn * r1_rho0 - 1._wp               ! unmasked in situ density anomaly 
     545            ! 
     546         END_2D 
     547         ! 
     548      CASE( np_seos )                !==  simplified EOS  ==! 
     549         ! 
     550         DO_2D_11_11 
     551            ! 
     552            zt    = pts  (ji,jj,jp_tem)  - 10._wp 
     553            zs    = pts  (ji,jj,jp_sal)  - 35._wp 
     554            zh    = pdep (ji,jj)                         ! depth at the partial step level 
     555            ! 
     556            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     557               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     558               &  - rn_nu * zt * zs 
     559               ! 
     560            prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
     561            ! 
     562         END_2D 
    597563         ! 
    598564      CASE( np_leos )                !==  ISOMIP EOS  ==! 
    599565         ! 
    600          DO jj = 1, jpjm1 
    601             DO ji = 1, fs_jpim1   ! vector opt. 
    602                ! 
    603                zt    = pts  (ji,jj,jp_tem)  - (-1._wp) 
    604                zs    = pts  (ji,jj,jp_sal)  - 34.2_wp 
    605                zh    = pdep (ji,jj)                         ! depth at the partial step level 
    606                ! 
    607                zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
    608                   ! 
    609                prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
    610                ! 
    611             END DO 
    612          END DO 
    613          ! 
    614          CALL lbc_lnk( 'eosbn2', prd, 'T', 1. )                    ! Lateral boundary conditions 
     566         DO_2D_11_11 
     567            ! 
     568            zt    = pts  (ji,jj,jp_tem)  - (-1._wp) 
     569            zs    = pts  (ji,jj,jp_sal)  - 34.2_wp 
     570            zh    = pdep (ji,jj)                         ! depth at the partial step level 
     571            ! 
     572            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     573            ! 
     574            prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
     575            ! 
     576         END_2D 
     577         ! 
    615578         ! 
    616579      END SELECT 
    617580      ! 
    618       IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
     581      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    619582      ! 
    620583      IF( ln_timing )   CALL timing_stop('eos2d') 
     
    648611      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    649612         ! 
    650          DO jk = 1, jpkm1 
    651             DO jj = 1, jpj 
    652                DO ji = 1, jpi 
    653                   ! 
    654                   zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
    655                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    656                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    657                   ztm = tmask(ji,jj,jk)                                         ! tmask 
    658                   ! 
    659                   ! alpha 
    660                   zn3 = ALP003 
    661                   ! 
    662                   zn2 = ALP012*zt + ALP102*zs+ALP002 
    663                   ! 
    664                   zn1 = ((ALP031*zt   & 
    665                      &   + ALP121*zs+ALP021)*zt   & 
    666                      &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
    667                      &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
    668                      ! 
    669                   zn0 = ((((ALP050*zt   & 
    670                      &   + ALP140*zs+ALP040)*zt   & 
    671                      &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
    672                      &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
    673                      &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
    674                      &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
    675                      ! 
    676                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    677                   ! 
    678                   pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 
    679                   ! 
    680                   ! beta 
    681                   zn3 = BET003 
    682                   ! 
    683                   zn2 = BET012*zt + BET102*zs+BET002 
    684                   ! 
    685                   zn1 = ((BET031*zt   & 
    686                      &   + BET121*zs+BET021)*zt   & 
    687                      &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
    688                      &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
    689                      ! 
    690                   zn0 = ((((BET050*zt   & 
    691                      &   + BET140*zs+BET040)*zt   & 
    692                      &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
    693                      &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
    694                      &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
    695                      &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
    696                      ! 
    697                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    698                   ! 
    699                   pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 
    700                   ! 
    701                END DO 
    702             END DO 
    703          END DO 
     613         DO_3D_11_11( 1, jpkm1 ) 
     614            ! 
     615            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
     616            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     617            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     618            ztm = tmask(ji,jj,jk)                                         ! tmask 
     619            ! 
     620            ! alpha 
     621            zn3 = ALP003 
     622            ! 
     623            zn2 = ALP012*zt + ALP102*zs+ALP002 
     624            ! 
     625            zn1 = ((ALP031*zt   & 
     626               &   + ALP121*zs+ALP021)*zt   & 
     627               &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     628               &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     629               ! 
     630            zn0 = ((((ALP050*zt   & 
     631               &   + ALP140*zs+ALP040)*zt   & 
     632               &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     633               &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     634               &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     635               &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     636               ! 
     637            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     638            ! 
     639            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 
     640            ! 
     641            ! beta 
     642            zn3 = BET003 
     643            ! 
     644            zn2 = BET012*zt + BET102*zs+BET002 
     645            ! 
     646            zn1 = ((BET031*zt   & 
     647               &   + BET121*zs+BET021)*zt   & 
     648               &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     649               &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     650               ! 
     651            zn0 = ((((BET050*zt   & 
     652               &   + BET140*zs+BET040)*zt   & 
     653               &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     654               &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     655               &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     656               &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     657               ! 
     658            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     659            ! 
     660            pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 
     661            ! 
     662         END_3D 
    704663         ! 
    705664      CASE( np_seos )                  !==  simplified EOS  ==! 
    706665         ! 
    707          DO jk = 1, jpkm1 
    708             DO jj = 1, jpj 
    709                DO ji = 1, jpi 
    710                   zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    711                   zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    712                   zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters at t-point 
    713                   ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
    714                   ! 
    715                   zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    716                   pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
    717                   ! 
    718                   zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    719                   pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
    720                   ! 
    721                END DO 
    722             END DO 
    723          END DO 
     666         DO_3D_11_11( 1, jpkm1 ) 
     667            zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     668            zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     669            zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters at t-point 
     670            ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
     671            ! 
     672            zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     673            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
     674            ! 
     675            zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     676            pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
     677            ! 
     678         END_3D 
    724679         ! 
    725680      CASE( np_leos )                  !==  linear ISOMIP EOS  ==! 
    726681         ! 
    727          DO jk = 1, jpkm1 
    728             DO jj = 1, jpj 
    729                DO ji = 1, jpi 
    730                   zt  = pts (ji,jj,jk,jp_tem) - (-1._wp) 
    731                   zs  = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
    732                   zh  = gdept(ji,jj,jk,Kmm)                 ! depth in meters at t-point 
    733                   ztm = tmask(ji,jj,jk)                   ! land/sea bottom mask = surf. mask 
    734                   ! 
    735                   zn  = rn_a0 * rho0 
    736                   pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
    737                   ! 
    738                   zn  = rn_b0 * rho0 
    739                   pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
    740                   ! 
    741                END DO 
    742             END DO 
    743          END DO 
     682         DO_3D_11_11( 1, jpkm1 ) 
     683            zt  = pts (ji,jj,jk,jp_tem) - (-1._wp) 
     684            zs  = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
     685            zh  = gdept(ji,jj,jk,Kmm)                 ! depth in meters at t-point 
     686            ztm = tmask(ji,jj,jk)                   ! land/sea bottom mask = surf. mask 
     687            ! 
     688            zn  = rn_a0 * rho0 
     689            pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
     690            ! 
     691            zn  = rn_b0 * rho0 
     692            pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
     693            ! 
     694         END_3D 
    744695         ! 
    745696      CASE DEFAULT 
     
    749700      END SELECT 
    750701      ! 
    751       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 
    752          &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 
     702      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 
     703         &                                  tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 
    753704      ! 
    754705      IF( ln_timing )   CALL timing_stop('rab_3d') 
     
    783734      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    784735         ! 
    785          DO jj = 1, jpjm1 
    786             DO ji = 1, fs_jpim1   ! vector opt. 
    787                ! 
    788                zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
    789                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
    790                zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    791                ! 
    792                ! alpha 
    793                zn3 = ALP003 
    794                ! 
    795                zn2 = ALP012*zt + ALP102*zs+ALP002 
    796                ! 
    797                zn1 = ((ALP031*zt   & 
    798                   &   + ALP121*zs+ALP021)*zt   & 
    799                   &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
    800                   &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
    801                   ! 
    802                zn0 = ((((ALP050*zt   & 
    803                   &   + ALP140*zs+ALP040)*zt   & 
    804                   &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
    805                   &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
    806                   &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
    807                   &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
    808                   ! 
    809                zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    810                ! 
    811                pab(ji,jj,jp_tem) = zn * r1_rho0 
    812                ! 
    813                ! beta 
    814                zn3 = BET003 
    815                ! 
    816                zn2 = BET012*zt + BET102*zs+BET002 
    817                ! 
    818                zn1 = ((BET031*zt   & 
    819                   &   + BET121*zs+BET021)*zt   & 
    820                   &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
    821                   &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
    822                   ! 
    823                zn0 = ((((BET050*zt   & 
    824                   &   + BET140*zs+BET040)*zt   & 
    825                   &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
    826                   &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
    827                   &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
    828                   &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
    829                   ! 
    830                zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    831                ! 
    832                pab(ji,jj,jp_sal) = zn / zs * r1_rho0 
    833                ! 
    834                ! 
    835             END DO 
    836          END DO 
    837          !                            ! Lateral boundary conditions 
    838          CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                     
     736         DO_2D_11_11 
     737            ! 
     738            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     739            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     740            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     741            ! 
     742            ! alpha 
     743            zn3 = ALP003 
     744            ! 
     745            zn2 = ALP012*zt + ALP102*zs+ALP002 
     746            ! 
     747            zn1 = ((ALP031*zt   & 
     748               &   + ALP121*zs+ALP021)*zt   & 
     749               &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     750               &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     751               ! 
     752            zn0 = ((((ALP050*zt   & 
     753               &   + ALP140*zs+ALP040)*zt   & 
     754               &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     755               &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     756               &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     757               &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     758               ! 
     759            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     760            ! 
     761            pab(ji,jj,jp_tem) = zn * r1_rho0 
     762            ! 
     763            ! beta 
     764            zn3 = BET003 
     765            ! 
     766            zn2 = BET012*zt + BET102*zs+BET002 
     767            ! 
     768            zn1 = ((BET031*zt   & 
     769               &   + BET121*zs+BET021)*zt   & 
     770               &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     771               &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     772               ! 
     773            zn0 = ((((BET050*zt   & 
     774               &   + BET140*zs+BET040)*zt   & 
     775               &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     776               &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     777               &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     778               &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     779               ! 
     780            zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     781            ! 
     782            pab(ji,jj,jp_sal) = zn / zs * r1_rho0 
     783            ! 
     784            ! 
     785         END_2D 
    839786         ! 
    840787      CASE( np_seos )                  !==  simplified EOS  ==! 
    841788         ! 
    842          DO jj = 1, jpjm1 
    843             DO ji = 1, fs_jpim1   ! vector opt. 
    844                ! 
    845                zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    846                zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    847                zh    = pdep (ji,jj)                   ! depth at the partial step level 
    848                ! 
    849                zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    850                pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
    851                ! 
    852                zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    853                pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
    854                ! 
    855             END DO 
    856          END DO 
    857          !                            ! Lateral boundary conditions 
    858          CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                     
     789         DO_2D_11_11 
     790            ! 
     791            zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     792            zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     793            zh    = pdep (ji,jj)                   ! depth at the partial step level 
     794            ! 
     795            zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     796            pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
     797            ! 
     798            zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     799            pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
     800            ! 
     801         END_2D 
    859802         ! 
    860803      CASE( np_leos )                  !==  linear ISOMIP EOS  ==! 
    861804         ! 
    862          DO jj = 1, jpjm1 
    863             DO ji = 1, fs_jpim1   ! vector opt. 
    864                ! 
    865                zt    = pts  (ji,jj,jp_tem) - (-1._wp)   ! pot. temperature anomaly (t-T0) 
    866                zs    = pts  (ji,jj,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
    867                zh    = pdep (ji,jj)                   ! depth at the partial step level 
    868                ! 
    869                zn  = rn_a0 * rho0 
    870                pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
    871                ! 
    872                zn  = rn_b0 * rho0 
    873                pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
    874                ! 
    875             END DO 
    876          END DO 
    877          ! 
    878          CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )                    ! Lateral boundary conditions 
     805         DO_2D_11_11 
     806            ! 
     807            zt    = pts  (ji,jj,jp_tem) - (-1._wp)   ! pot. temperature anomaly (t-T0) 
     808            zs    = pts  (ji,jj,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
     809            zh    = pdep (ji,jj)                   ! depth at the partial step level 
     810            ! 
     811            zn  = rn_a0 * rho0 
     812            pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
     813            ! 
     814            zn  = rn_b0 * rho0 
     815            pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
     816            ! 
     817         END_2D 
    879818         ! 
    880819      CASE DEFAULT 
     
    884823      END SELECT 
    885824      ! 
    886       IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 
    887          &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
     825      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 
     826         &                                  tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
    888827      ! 
    889828      IF( ln_timing )   CALL timing_stop('rab_2d') 
     
    1026965      IF( ln_timing )   CALL timing_start('bn2') 
    1027966      ! 
    1028       DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    1029          DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
    1030             DO ji = 1, jpi 
    1031                zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    1032                   &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
    1033                   ! 
    1034                zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
    1035                zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
    1036                ! 
    1037                pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
    1038                   &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
    1039                   &            / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
    1040             END DO 
    1041          END DO 
    1042       END DO 
    1043       ! 
    1044       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', kdim=jpk ) 
     967      DO_3D_11_11( 2, jpkm1 ) 
     968         zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
     969            &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
     970            ! 
     971         zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     972         zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
     973         ! 
     974         pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
     975            &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
     976            &            / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
     977      END_3D 
     978      ! 
     979      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', kdim=jpk ) 
    1045980      ! 
    1046981      IF( ln_timing )   CALL timing_stop('bn2') 
     
    10781013      z1_T0   = 1._wp/40._wp 
    10791014      ! 
    1080       DO jj = 1, jpj 
    1081          DO ji = 1, jpi 
    1082             ! 
    1083             zt  = ctmp   (ji,jj) * z1_T0 
    1084             zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 
    1085             ztm = tmask(ji,jj,1) 
    1086             ! 
    1087             zn = ((((-2.1385727895e-01_wp*zt   & 
    1088                &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   & 
    1089                &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   & 
    1090                &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   & 
    1091                &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   & 
    1092                &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   & 
    1093                &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   & 
    1094                &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 
    1095                ! 
    1096             zd = (2.0035003456_wp*zt   & 
    1097                &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   & 
    1098                &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 
    1099                ! 
    1100             ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 
    1101                ! 
    1102          END DO 
    1103       END DO 
     1015      DO_2D_11_11 
     1016         ! 
     1017         zt  = ctmp   (ji,jj) * z1_T0 
     1018         zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 
     1019         ztm = tmask(ji,jj,1) 
     1020         ! 
     1021         zn = ((((-2.1385727895e-01_wp*zt   & 
     1022            &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   & 
     1023            &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   & 
     1024            &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   & 
     1025            &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   & 
     1026            &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   & 
     1027            &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   & 
     1028            &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 
     1029            ! 
     1030         zd = (2.0035003456_wp*zt   & 
     1031            &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   & 
     1032            &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 
     1033            ! 
     1034         ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 
     1035            ! 
     1036      END_2D 
    11041037      ! 
    11051038      IF( ln_timing )   CALL timing_stop('eos_pt_from_ct') 
     
    11331066         ! 
    11341067         z1_S0 = 1._wp / 35.16504_wp 
    1135          DO jj = 1, jpj 
    1136             DO ji = 1, jpi 
    1137                zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity 
    1138                ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
    1139                   &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
    1140             END DO 
    1141          END DO 
     1068         DO_2D_11_11 
     1069            zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity 
     1070            ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
     1071               &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
     1072         END_2D 
    11421073         ptf(:,:) = ptf(:,:) * psal(:,:) 
    11431074         ! 
    11441075         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
    11451076         ! 
    1146       CASE ( np_eos80, np_leos )                !==  PT,SP (UNESCO formulation)  ==! 
     1077      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==! 
    11471078         ! 
    11481079         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
     
    11901121         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep 
    11911122         ! 
    1192       CASE ( np_eos80, np_leos )                !==  PT,SP (UNESCO formulation)  ==! 
     1123      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==! 
    11931124         ! 
    11941125         ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   & 
     
    12421173      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    12431174         ! 
    1244          DO jk = 1, jpkm1 
    1245             DO jj = 1, jpj 
    1246                DO ji = 1, jpi 
    1247                   ! 
    1248                   zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
    1249                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    1250                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    1251                   ztm = tmask(ji,jj,jk)                                         ! tmask 
    1252                   ! 
    1253                   ! potential energy non-linear anomaly 
    1254                   zn2 = (PEN012)*zt   & 
    1255                      &   + PEN102*zs+PEN002 
    1256                      ! 
    1257                   zn1 = ((PEN021)*zt   & 
    1258                      &   + PEN111*zs+PEN011)*zt   & 
    1259                      &   + (PEN201*zs+PEN101)*zs+PEN001 
    1260                      ! 
    1261                   zn0 = ((((PEN040)*zt   & 
    1262                      &   + PEN130*zs+PEN030)*zt   & 
    1263                      &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   & 
    1264                      &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   & 
    1265                      &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 
    1266                      ! 
    1267                   zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1268                   ! 
    1269                   ppen(ji,jj,jk)  = zn * zh * r1_rho0 * ztm 
    1270                   ! 
    1271                   ! alphaPE non-linear anomaly 
    1272                   zn2 = APE002 
    1273                   ! 
    1274                   zn1 = (APE011)*zt   & 
    1275                      &   + APE101*zs+APE001 
    1276                      ! 
    1277                   zn0 = (((APE030)*zt   & 
    1278                      &   + APE120*zs+APE020)*zt   & 
    1279                      &   + (APE210*zs+APE110)*zs+APE010)*zt   & 
    1280                      &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 
    1281                      ! 
    1282                   zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1283                   !                               
    1284                   pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 
    1285                   ! 
    1286                   ! betaPE non-linear anomaly 
    1287                   zn2 = BPE002 
    1288                   ! 
    1289                   zn1 = (BPE011)*zt   & 
    1290                      &   + BPE101*zs+BPE001 
    1291                      ! 
    1292                   zn0 = (((BPE030)*zt   & 
    1293                      &   + BPE120*zs+BPE020)*zt   & 
    1294                      &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   & 
    1295                      &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 
    1296                      ! 
    1297                   zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1298                   !                               
    1299                   pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 
    1300                   ! 
    1301                END DO 
    1302             END DO 
    1303          END DO 
     1175         DO_3D_11_11( 1, jpkm1 ) 
     1176            ! 
     1177            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
     1178            zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     1179            zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     1180            ztm = tmask(ji,jj,jk)                                         ! tmask 
     1181            ! 
     1182            ! potential energy non-linear anomaly 
     1183            zn2 = (PEN012)*zt   & 
     1184               &   + PEN102*zs+PEN002 
     1185               ! 
     1186            zn1 = ((PEN021)*zt   & 
     1187               &   + PEN111*zs+PEN011)*zt   & 
     1188               &   + (PEN201*zs+PEN101)*zs+PEN001 
     1189               ! 
     1190            zn0 = ((((PEN040)*zt   & 
     1191               &   + PEN130*zs+PEN030)*zt   & 
     1192               &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   & 
     1193               &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   & 
     1194               &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 
     1195               ! 
     1196            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1197            ! 
     1198            ppen(ji,jj,jk)  = zn * zh * r1_rho0 * ztm 
     1199            ! 
     1200            ! alphaPE non-linear anomaly 
     1201            zn2 = APE002 
     1202            ! 
     1203            zn1 = (APE011)*zt   & 
     1204               &   + APE101*zs+APE001 
     1205               ! 
     1206            zn0 = (((APE030)*zt   & 
     1207               &   + APE120*zs+APE020)*zt   & 
     1208               &   + (APE210*zs+APE110)*zs+APE010)*zt   & 
     1209               &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 
     1210               ! 
     1211            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1212            !                               
     1213            pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 
     1214            ! 
     1215            ! betaPE non-linear anomaly 
     1216            zn2 = BPE002 
     1217            ! 
     1218            zn1 = (BPE011)*zt   & 
     1219               &   + BPE101*zs+BPE001 
     1220               ! 
     1221            zn0 = (((BPE030)*zt   & 
     1222               &   + BPE120*zs+BPE020)*zt   & 
     1223               &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   & 
     1224               &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 
     1225               ! 
     1226            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1227            !                               
     1228            pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 
     1229            ! 
     1230         END_3D 
    13041231         ! 
    13051232      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==! 
    13061233         ! 
    1307          DO jk = 1, jpkm1 
    1308             DO jj = 1, jpj 
    1309                DO ji = 1, jpi 
    1310                   zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
    1311                   zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
    1312                   zh  = gdept(ji,jj,jk,Kmm)              ! depth in meters  at t-point 
    1313                   ztm = tmask(ji,jj,jk)                ! tmask 
    1314                   zn  = 0.5_wp * zh * r1_rho0 * ztm 
    1315                   !                                    ! Potential Energy 
    1316                   ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
    1317                   !                                    ! alphaPE 
    1318                   pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
    1319                   pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
    1320                   ! 
    1321                END DO 
    1322             END DO 
    1323          END DO 
     1234         DO_3D_11_11( 1, jpkm1 ) 
     1235            zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
     1236            zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
     1237            zh  = gdept(ji,jj,jk,Kmm)              ! depth in meters  at t-point 
     1238            ztm = tmask(ji,jj,jk)                ! tmask 
     1239            zn  = 0.5_wp * zh * r1_rho0 * ztm 
     1240            !                                    ! Potential Energy 
     1241            ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
     1242            !                                    ! alphaPE 
     1243            pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
     1244            pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
     1245            ! 
     1246         END_3D 
    13241247         ! 
    13251248      CASE( np_leos )                !==  linear ISOMIP EOS  ==! 
    13261249         ! 
    1327          DO jk = 1, jpkm1 
    1328             DO jj = 1, jpj 
    1329                DO ji = 1, jpi 
    1330                   zt  = pts(ji,jj,jk,jp_tem) - (-1._wp)  ! temperature anomaly (t-T0) 
    1331                   zs = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
    1332                   zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters  at t-point 
    1333                   ztm = tmask(ji,jj,jk)                  ! tmask 
    1334                   zn  = 0.5_wp * zh * r1_rho0 * ztm 
    1335                   !                                    ! Potential Energy 
    1336                   ppen(ji,jj,jk) = 0. 
    1337                   !                                    ! alphaPE 
    1338                   pab_pe(ji,jj,jk,jp_tem) = 0. 
    1339                   pab_pe(ji,jj,jk,jp_sal) = 0. 
    1340                   ! 
    1341                END DO 
    1342             END DO 
    1343          END DO 
     1250         DO_3D_11_11( 1, jpkm1 ) 
     1251            zt  = pts(ji,jj,jk,jp_tem) - (-1._wp)  ! temperature anomaly (t-T0) 
     1252            zs = pts (ji,jj,jk,jp_sal) - 34.2_wp   ! abs. salinity anomaly (s-S0) 
     1253            zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters  at t-point 
     1254            ztm = tmask(ji,jj,jk)                  ! tmask 
     1255            zn  = 0.5_wp * zh * r1_rho0 * ztm 
     1256            !                                    ! Potential Energy 
     1257            ppen(ji,jj,jk) = 0. 
     1258            !                                    ! alphaPE 
     1259            pab_pe(ji,jj,jk,jp_tem) = 0. 
     1260            pab_pe(ji,jj,jk,jp_sal) = 0. 
     1261            ! 
     1262         END_3D 
    13441263         ! 
    13451264      CASE DEFAULT 
     
    13651284      INTEGER  ::   ioptio   ! local integer 
    13661285      !! 
    1367       NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS   , ln_LEOS, & 
    1368          &             rn_a0    , rn_b0   , rn_lambda1, rn_mu1 , & 
    1369          &                                  rn_lambda2, rn_mu2 , rn_nu 
    1370       !!---------------------------------------------------------------------- 
    1371       ! 
    1372       REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
     1286      NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, rn_a0, rn_b0, & 
     1287         &             rn_lambda1, rn_mu1, rn_lambda2, rn_mu2, rn_nu 
     1288      !!---------------------------------------------------------------------- 
     1289      ! 
    13731290      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    13741291901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nameos in reference namelist' ) 
    13751292      ! 
    1376       REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    13771293      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    13781294902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nameos in configuration namelist' ) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/isfcavgam.F90

    r12077 r13159  
    9191         pgs(:,:) = rn_gammas0 
    9292      CASE ( 'vel' ) ! gamma is proportional to u* 
    93          CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, r_ke0_top,               pgt, pgs ) 
     93         CALL gammats_vel      (                   zutbl, zvtbl, rCd0_top, rn_vtide**2,               pgt, pgs ) 
    9494      CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 
    95          CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs ) 
     95         CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, rn_vtide**2, pqoce, pqfwf, pgt, pgs ) 
    9696      CASE DEFAULT 
    9797         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/isfstp.F90

    r12077 r13159  
    250250      IF ( l_isfoasis .AND. ln_isf ) THEN 
    251251         ! 
    252          CALL ctl_stop( ' ln_ctl and ice shelf not tested' ) 
     252         CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' ) 
    253253         ! 
    254254         ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation  
     
    291291      !!---------------------------------------------------------------------- 
    292292      ! 
    293       REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    294293      READ  ( numnam_ref, namisf, IOSTAT = ios, ERR = 901) 
    295294901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namisf in reference namelist' ) 
    296295      ! 
    297       REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs 
    298296      READ  ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 ) 
    299297902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namisf in configuration namelist' ) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/istate.F90

    r12353 r13159  
    4141   PUBLIC   istate_init   ! routine called by step.F90 
    4242 
     43   !! * Substitutions 
     44#  include "do_loop_substitute.h90" 
    4345   !!---------------------------------------------------------------------- 
    4446   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    7577      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    7678      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    77       ts   (:,:,:,:,Kaa) = 0._wp                               ! set one for all to 0 at level jpk 
     79      ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
    7880      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    7981#if defined key_agrif 
     
    9092         !                                    ! --------------- 
    9193         numror = 0                           ! define numror = 0 -> no restart file to read 
    92          neuler = 0                           ! Set time-step indicator at nit000 (euler forward) 
     94         l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward) 
    9395         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    9496         !                                    ! Initialization of ocean to zero 
     
    103105               ! Apply minimum wetdepth criterion 
    104106               ! 
    105                DO jj = 1,jpj 
    106                   DO ji = 1,jpi 
    107                      IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    108                         ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    109                      ENDIF 
    110                   END DO 
    111                END DO  
     107               DO_2D_11_11 
     108                  IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
     109                     ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
     110                  ENDIF 
     111               END_2D 
    112112            ENDIF  
    113113            uu  (:,:,:,Kbb) = 0._wp 
     
    159159      ! 
    160160!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
    161       DO jk = 1, jpkm1 
    162          DO jj = 1, jpj 
    163             DO ji = 1, jpi 
    164                uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    165                vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
    166                ! 
    167                uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
    168                vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
    169             END DO 
    170          END DO 
    171       END DO 
     161      DO_3D_11_11( 1, jpkm1 ) 
     162         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     163         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     164         ! 
     165         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
     166         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
     167      END_3D 
    172168      ! 
    173169      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/sbcfwb.F90

    r12489 r13159  
    151151         ENDIF    
    152152         !                                         ! Update fwfold if new year start 
    153          ikty = 365 * 86400 / rn_Dt               !!bug  use of 365 days leap year or 360d year !!!!!!! 
     153         ikty = 365 * 86400 / rn_Dt                  !!bug  use of 365 days leap year or 360d year !!!!!!! 
    154154         IF( MOD( kt, ikty ) == 0 ) THEN 
    155155            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/tradmp.F90

    r12353 r13159  
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    5252 
     53   !! * Substitutions 
     54#  include "do_loop_substitute.h90" 
    5355   !!---------------------------------------------------------------------- 
    5456   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    110112      CASE( 0 )                        !*  newtonian damping throughout the water column  *! 
    111113         DO jn = 1, jpts 
    112             DO jk = 1, jpkm1 
    113                DO jj = 2, jpjm1 
    114                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    115                      pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           & 
    116                         &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 
    117                   END DO 
    118                END DO 
    119             END DO 
     114            DO_3D_00_00( 1, jpkm1 ) 
     115               pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           & 
     116                  &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 
     117            END_3D 
    120118         END DO 
    121119         ! 
    122120      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *! 
    123          DO jk = 1, jpkm1 
    124             DO jj = 2, jpjm1 
    125                DO ji = fs_2, fs_jpim1   ! vector opt. 
    126                   IF( avt(ji,jj,jk) <= avt_c ) THEN 
    127                      pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
    128                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
    129                      pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
    130                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
    131                   ENDIF 
    132                END DO 
    133             END DO 
    134          END DO 
     121         DO_3D_00_00( 1, jpkm1 ) 
     122            IF( avt(ji,jj,jk) <= avt_c ) THEN 
     123               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     124                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
     125               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
     126                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
     127            ENDIF 
     128         END_3D 
    135129         ! 
    136130      CASE ( 2 )                       !*  no damping in the mixed layer   *! 
    137          DO jk = 1, jpkm1 
    138             DO jj = 2, jpjm1 
    139                DO ji = fs_2, fs_jpim1   ! vector opt. 
    140                   IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
    141                      pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
    142                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
    143                      pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
    144                         &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
    145                   ENDIF 
    146                END DO 
    147             END DO 
    148          END DO 
     131         DO_3D_00_00( 1, jpkm1 ) 
     132            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
     133               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     134                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
     135               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
     136                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
     137            ENDIF 
     138         END_3D 
    149139         ! 
    150140      END SELECT 
     
    157147      ENDIF 
    158148      !                           ! Control print 
    159       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
    160          &                       tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     149      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
     150         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    161151      ! 
    162152      IF( ln_timing )   CALL timing_stop('tra_dmp') 
     
    178168      !!---------------------------------------------------------------------- 
    179169      ! 
    180       REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation 
    181170      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 
    182171901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' ) 
    183172      ! 
    184       REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation 
    185173      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 
    186174902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' ) 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/file_def_nemo-oce.xml

    r11930 r13159  
    2828      <field field_ref="empmr"        name="empmr" /> 
    2929      <!-- --> 
    30       <field field_ref="taum"         name="taum"     /> 
    31       <field field_ref="wspd"         name="windsp"   /> 
     30      <field field_ref="taum"         name="taum"   /> 
     31      <field field_ref="wspd"         name="windsp" /> 
     32      <!-- --> 
     33      <field field_ref="Cd_oce"       name="Cd_oce" /> 
     34      <field field_ref="Ce_oce"       name="Ce_oce" /> 
     35      <field field_ref="Ch_oce"       name="Ch_oce" /> 
     36      <field field_ref="theta_zt"     name="theta_zt" /> 
     37      <field field_ref="q_zt"         name="q_zt" /> 
     38      <field field_ref="theta_zu"     name="theta_zu" /> 
     39      <field field_ref="q_zu"         name="q_zu" /> 
     40      <field field_ref="ssq"          name="ssq" /> 
     41      <field field_ref="wspd_blk"     name="wspd_blk" />       
    3242    </file> 
    3343 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/launch_sasf.sh

    r11996 r13159  
    11#!/bin/bash 
    22 
    3 # NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 
    4 NEMO_DIR="${HOME}/NEMO/NEMOvdev_r11085_ASINTER-05_Brodeau_Advanced_Bulk" 
     3################################################################ 
     4# 
     5# Script to launch a set of STATION_ASF simulations 
     6# 
     7# L. Brodeau, 2020 
     8# 
     9################################################################ 
     10 
     11# What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 
     12TC_DIR="STATION_ASF2" 
     13 
     14# DATA_IN_DIR => Directory containing sea-surface + atmospheric forcings 
     15#             (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 
     16if [ `hostname` = "merlat"        ]; then 
     17    DATA_IN_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     18elif [ `hostname` = "luitel"        ]; then 
     19    DATA_IN_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     20elif [ `hostname` = "ige-meom-cal1" ]; then 
     21    DATA_IN_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     22elif [ `hostname` = "salvelinus" ]; then 
     23    DATA_IN_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     24else 
     25    echo "Oops! We don't know `hostname` yet! Define 'DATA_IN_DIR' in the script!"; exit  
     26fi 
     27 
     28expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 
     29 
     30# NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe + setup: 
     31NEMO_WRK_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 
    532 
    633# Directory where to run the simulation: 
    7 WORK_DIR="${HOME}/tmp/STATION_ASF" 
     34PROD_DIR="${HOME}/tmp/STATION_ASF" 
    835 
    936 
    10 # FORC_DIR => Directory containing sea-surface + atmospheric forcings 
    11 #             (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 
    12 if [ `hostname` = "merlat"        ]; then 
    13     FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    14 elif [ `hostname` = "luitel"        ]; then 
    15     FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    16 elif [ `hostname` = "ige-meom-cal1" ]; then 
    17     FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    18 elif [ `hostname` = "salvelinus" ]; then 
    19     FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    20 else 
    21     echo "Boo!"; exit 
    22 fi 
    23 #====================== 
    24 mkdir -p ${WORK_DIR} 
     37####### End of normal user configurable section ####### 
    2538 
    26 NEMO_EXE="${NEMO_DIR}/tests/STATION_ASF/BLD/bin/nemo.exe" 
    27 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 
     39#================================================================================ 
    2840 
    29 NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF" 
     41# NEMO executable to use is: 
     42NEMO_EXE="${NEMO_WRK_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 
     43 
     44 
     45echo "###########################################################" 
     46echo "#        S T A T I O N   A i r  -  S e a   F l u x        #" 
     47echo "###########################################################" 
     48echo 
     49echo " We shall work in here: ${STATION_ASF_DIR}/" 
     50echo " NEMOGCM   work    depository is: ${NEMO_WRK_DIR}/" 
     51echo "   ==> NEMO EXE to use: ${NEMO_EXE}" 
     52echo " Input forcing data into: ${DATA_IN_DIR}/" 
     53echo " Production will be done into: ${PROD_DIR}/" 
     54echo 
     55 
     56mkdir -p ${PROD_DIR} 
     57 
     58if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 
     59 
     60echo 
     61echo " *** Using the following NEMO executable:" 
     62echo "  ${NEMO_EXE} " 
     63echo 
     64 
     65NEMO_EXPREF="${NEMO_WRK_DIR}/tests/STATION_ASF/EXPREF" 
    3066if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi 
    3167 
    32 rsync -avP ${NEMO_EXE}          ${WORK_DIR}/ 
     68rsync -avP ${NEMO_EXE}          ${PROD_DIR}/ 
    3369 
    3470for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 
    3571    if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi 
    36     rsync -avPL ${NEMO_EXPREF}/${ff} ${WORK_DIR}/ 
     72    rsync -avPL ${NEMO_EXPREF}/${ff} ${PROD_DIR}/ 
    3773done 
    3874 
    3975# Copy forcing to work directory: 
    40 rsync -avP ${FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/ 
     76rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/ 
    4177 
    42 for CASE in "ECMWF-noskin" "COARE3p6-noskin" "ECMWF" "COARE3p6" "NCAR"; do 
     78for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 
    4379 
    4480    echo ; echo 
     
    5086    scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 
    5187 
    52     rm -f ${WORK_DIR}/namelist_cfg 
    53     rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${WORK_DIR}/namelist_cfg 
     88    rm -f ${PROD_DIR}/namelist_cfg 
     89    rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg 
    5490 
    55     cd ${WORK_DIR}/ 
     91    cd ${PROD_DIR}/ 
    5692    echo 
    5793    echo "Launching NEMO !" 
    58     ./nemo.exe 1> out_nemo.out 2>err_nemo.err 
     94    ./nemo.exe 1>out_nemo.out 2>err_nemo.err 
    5995    echo "Done!" 
    6096    echo 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg

    r12489 r13159  
    2929   cn_exp      =  'STATION_ASF-COARE3p6-noskin'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    3638      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg

    r12489 r13159  
    2929   cn_exp      =  'STATION_ASF-COARE3p6'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    3638      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
     
    134140      ln_humi_rlh = .true.  !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    135141   ! 
    136    cn_dir      = './'      !  root directory for the bulk data location 
     142   cn_dir = './'  !  root directory for the bulk data location 
    137143   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    138144   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
     
    163169      ln_read_frq = .false.   !  specify whether we must read frq or not 
    164170 
    165    cn_dir      = './'      !  root directory for the ocean data location 
     171   cn_dir      = './'     !  root directory for the ocean data location 
    166172   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    167173   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     
    215221&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    216222!----------------------------------------------------------------------- 
    217    ln_eos80    = .true.         !  = Use EOS80 
     223   ln_eos80    = .true.          !  = Use EOS80 
    218224/ 
    219225!!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg

    r12489 r13159  
    2929   cn_exp      =  'STATION_ASF-ECMWF-noskin'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    3638      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg

    r12489 r13159  
    2929   cn_exp      =  'STATION_ASF-ECMWF'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    3638      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
     
    134140      ln_humi_rlh = .true.  !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    135141   ! 
    136    cn_dir      = './'      !  root directory for the bulk data location 
     142   cn_dir = './'  !  root directory for the bulk data location 
    137143   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    138144   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
     
    163169      ln_read_frq = .false.   !  specify whether we must read frq or not 
    164170 
    165    cn_dir      = './'      !  root directory for the ocean data location 
     171   cn_dir      = './'     !  root directory for the ocean data location 
    166172   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    167173   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     
    215221&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    216222!----------------------------------------------------------------------- 
    217    ln_eos80    = .true.         !  = Use EOS80 
     223   ln_eos80    = .true.          !  = Use EOS80 
    218224/ 
    219225!!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ncar_cfg

    r12489 r13159  
    2929   cn_exp      =  'STATION_ASF-NCAR'  !  experience name 
    3030   nn_it000    =    1   !  first time step 
    31    nn_itend    =    26280   !  last  time step (std 5840) 
    32    nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     31!!!   nn_itend    =    26304   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     32!!!   nn_date0    =    20160101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     33   nn_itend    =    8760   !  last  time step => 3 years (including 1 leap!) at dt=3600s 
     34   nn_date0    = 20180101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    3335   nn_time0    =       0   !  initial time of day in hhmm 
    34    nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     36   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    3537   ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    3638      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     
    4547   nn_istate   =       0   !  output the initial state (1) or not (0) 
    4648   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    47    nn_stock    =    26280   ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 
    48    nn_write    =    26280   ! 1year @ dt=3600 s / frequency of write in the output file   (modulo referenced to nn_it000) 
     49   !! 
     50!!!   nn_stock    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     51!!!   nn_write    =    26304   ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     52   nn_stock    =    8760   ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 
     53   nn_write    =    8760   ! 1 year at dt=3600s / frequency of write in the output file   (modulo referenced to nn_it000) 
     54   !! 
    4955   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    5056   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard 
     
    134140      ln_humi_rlh = .true.  !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    135141   ! 
    136    cn_dir      = './'      !  root directory for the bulk data location 
     142   cn_dir = './'  !  root directory for the bulk data location 
    137143   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    138144   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
     
    163169      ln_read_frq = .false.   !  specify whether we must read frq or not 
    164170 
    165    cn_dir      = './'      !  root directory for the ocean data location 
     171   cn_dir      = './'     !  root directory for the ocean data location 
    166172   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    167173   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     
    215221&nameos        !   ocean Equation Of Seawater                           (default: NO selection) 
    216222!----------------------------------------------------------------------- 
    217    ln_eos80    = .true.         !  = Use EOS80 
     223   ln_eos80    = .true.          !  = Use EOS80 
    218224/ 
    219225!!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r12254 r13159  
    9898      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    9999         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    100          CALL ctl_stop( ctmp1 ) 
     100         WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     101         CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    101102      ENDIF 
    102103      ! 
     
    177178      ! 
    178179      ! finalize the definition of namctl variables 
    179       IF( sn_cfctl%l_allon ) THEN 
    180          ! Turn on all options. 
    181          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    182          ! Ensure all processors are active 
    183          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    184       ELSEIF( sn_cfctl%l_config ) THEN 
    185          ! Activate finer control of report outputs 
    186          ! optionally switch off output from selected areas (note this only 
    187          ! applies to output which does not involve global communications) 
    188          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    189            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    190            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    191       ELSE 
    192          ! turn off all options. 
    193          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    194       ENDIF 
     180      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     181         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    195182      ! 
    196183      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    311298         WRITE(numout,*) '~~~~~~~~' 
    312299         WRITE(numout,*) '   Namelist namctl' 
    313          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    314          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    315          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    316300         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    317301         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    449433 
    450434 
    451    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     435   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    452436      !!---------------------------------------------------------------------- 
    453437      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    454438      !! 
    455439      !! ** Purpose :   Set elements of the output control structure to setto. 
    456       !!                for_all should be .false. unless all areas are to be 
    457       !!                treated identically. 
    458440      !! 
    459441      !! ** Method  :   Note this routine can be used to switch on/off some 
    460       !!                types of output for selected areas but any output types 
    461       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    462       !!                should be protected from selective switching by the 
    463       !!                for_all argument 
    464       !!---------------------------------------------------------------------- 
    465       LOGICAL :: setto, for_all 
    466       TYPE(sn_ctl) :: sn_cfctl 
    467       !!---------------------------------------------------------------------- 
    468       IF( for_all ) THEN 
    469          sn_cfctl%l_runstat = setto 
    470          sn_cfctl%l_trcstat = setto 
    471       ENDIF 
     442      !!                types of output for selected areas. 
     443      !!---------------------------------------------------------------------- 
     444      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     445      LOGICAL     , INTENT(in   ) :: setto 
     446      !!---------------------------------------------------------------------- 
     447      sn_cfctl%l_runstat = setto 
     448      sn_cfctl%l_trcstat = setto 
    472449      sn_cfctl%l_oceout  = setto 
    473450      sn_cfctl%l_layout  = setto 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/stpctl.F90

    r12254 r13159  
    1919   USE dom_oce         ! ocean space and time domain variables 
    2020   USE sbc_oce         ! surface fluxes and stuff 
     21   ! 
    2122   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2323   USE in_out_manager  ! I/O manager 
    2424   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2525   USE lib_mpp         ! distributed memory computing 
    26  
     26   ! 
    2727   USE netcdf          ! NetCDF library 
    2828   IMPLICIT NONE 
     
    3131   PUBLIC stp_ctl           ! routine called by step.F90 
    3232 
    33    INTEGER  ::   idrun, idtime, idtau, idqns, idemp, istatus 
    34    LOGICAL  ::   lsomeoce 
     33   INTEGER                ::   nrunid   ! netcdf file id 
     34   INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    4040CONTAINS 
    4141 
    42    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     42   SUBROUTINE stp_ctl( kt, Kmm ) 
    4343      !!---------------------------------------------------------------------- 
    4444      !!                    ***  ROUTINE stp_ctl  *** 
    45       !! 
     45      !!                      
    4646      !! ** Purpose :   Control the run 
    4747      !! 
    4848      !! ** Method  : - Save the time step in numstp 
    4949      !!              - Print it each 50 time steps 
    50       !!              - Stop the run IF problem encountered by setting indic=-3 
     50      !!              - Stop the run IF problem encountered by setting nstop > 0 
     51      !!                Problems checked: wind stress module  max larger than 5 N/m^2 
     52      !!                                  non-solar heat flux max larger than 2000 W/m^2 
     53      !!                                  Evaporation-Precip  max larger than 1.E-3 kg/m^2/s 
    5154      !! 
    5255      !! ** Actions :   "time.step" file = last ocean time-step 
    5356      !!                "run.stat"  file = run statistics 
    54       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     57      !!                 nstop indicator sheared among all local domain 
    5558      !!---------------------------------------------------------------------- 
    5659      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    57       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    58       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    59       !! 
    60       REAL(wp), DIMENSION(3) ::   zmax 
    61       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    62       CHARACTER(len=20) :: clname 
    63       !!---------------------------------------------------------------------- 
    64       ! 
    65       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    66       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    67       ll_wrtruns = ll_colruns .AND. lwm 
    68       IF( kt == nit000 .AND. lwp ) THEN 
    69          WRITE(numout,*) 
    70          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    71          WRITE(numout,*) '~~~~~~~' 
    72          !                                ! open time.step file 
    73          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    74          !                                ! open run.stat file(s) at start whatever 
    75          !                                ! the value of sn_cfctl%ptimincr 
    76          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     60      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     61      !! 
     62      INTEGER                         ::   ji                                    ! dummy loop indices 
     63      INTEGER                         ::   idtime, istatus 
     64      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
     65      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
     66      REAL(wp)                        ::   zzz                                   ! local real  
     67      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     68      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     69      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     70      CHARACTER(len=20)               ::   clname 
     71      !!---------------------------------------------------------------------- 
     72      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     73      ! 
     74      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     75      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     76      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     77      ! 
     78      IF( kt == nit000 ) THEN 
     79         ! 
     80         IF( lwp ) THEN 
     81            WRITE(numout,*) 
     82            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     83            WRITE(numout,*) '~~~~~~~' 
     84         ENDIF 
     85         !                                ! open time.step    ascii file, done only by 1st subdomain 
     86         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     87         ! 
     88         IF( ll_wrtruns ) THEN 
     89            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    7790            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     91            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    7892            clname = 'run.stat.nc' 
    7993            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    80             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    81             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    82             istatus = NF90_DEF_VAR( idrun, 'tau_max', NF90_DOUBLE, (/ idtime /), idtau ) 
    83             istatus = NF90_DEF_VAR( idrun, 'qns_max', NF90_DOUBLE, (/ idtime /), idqns   ) 
    84             istatus = NF90_DEF_VAR( idrun, 'emp_max', NF90_DOUBLE, (/ idtime /), idemp   ) 
    85             istatus = NF90_ENDDEF(idrun) 
    86          ENDIF 
    87       ENDIF 
    88       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    89       ! 
    90       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     94            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     95            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     96            istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     97            istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     99            istatus = NF90_ENDDEF(nrunid) 
     100         ENDIF 
     101         !     
     102      ENDIF 
     103      ! 
     104      !                                   !==              write current time step              ==! 
     105      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     106      IF( lwm .AND. ll_wrtstp ) THEN 
    91107         WRITE ( numstp, '(1x, i8)' )   kt 
    92108         REWIND( numstp ) 
    93109      ENDIF 
    94       ! 
    95       !                                   !==  test of extrema  ==! 
    96       zmax(1) = MAXVAL(     taum(:,:)   , mask = tmask(:,:,1) == 1._wp )                                         ! max wind stress module 
    97       zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = tmask(:,:,1) == 1._wp )                                         ! max non-solar heat flux 
    98       zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = tmask(:,:,1) == 1._wp )                                         ! max E-P 
    99       ! 
     110      !                                   !==            test of local extrema           ==! 
     111      !                                   !==  done by all processes at every time step  ==! 
     112      llmsk(:,:) = tmask(:,:,1) == 1._wp 
     113      IF( COUNT( llmsk(:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     114         zmax(1) = MAXVAL(     taum(:,:)   , mask = llmsk )   ! max wind stress module 
     115         zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = llmsk )   ! max non-solar heat flux 
     116         zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = llmsk )   ! max E-P 
     117      ELSE 
     118         IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     119            zmax(1:3) = -HUGE(1._wp) 
     120         ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     121            zmax(1:3) = 0._wp 
     122         ENDIF 
     123      ENDIF 
     124      zmax(4) = REAL( nstop, wp )                                     ! stop indicator 
     125      !                                   !==               get global extrema             ==! 
     126      !                                   !==  done by all processes if writting run.stat  ==! 
    100127      IF( ll_colruns ) THEN 
     128         zmaxlocal(:) = zmax(:) 
    101129         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    102          nstop = NINT( zmax(3) )                 ! nstop indicator sheared among all local domains 
    103       ENDIF 
    104       !                                   !==  run statistics  ==!   ("run.stat" files) 
     130         nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     131      ENDIF 
     132      !                                   !==              write "run.stat" files              ==! 
     133      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    105134      IF( ll_wrtruns ) THEN 
    106135         WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 
    107          istatus = NF90_PUT_VAR( idrun, idtau, (/ zmax(1)/), (/kt/), (/1/) ) 
    108          istatus = NF90_PUT_VAR( idrun, idqns, (/ zmax(2)/), (/kt/), (/1/) ) 
    109          istatus = NF90_PUT_VAR( idrun, idemp, (/ zmax(3)/), (/kt/), (/1/) ) 
    110          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    111          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     136         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     137         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     138         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/ zmax(3)/), (/kt/), (/1/) ) 
     139         IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 
    112140      END IF 
    113       !                                   !==  error handling  ==! 
    114       IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges 
    115          &  zmax(1) >    5._wp .OR.   &             ! too large wind stress ( > 5 N/m^2 ) 
    116          &  zmax(2) > 2000._wp .OR.   &             ! too large non-solar heat flux ( > 2000 W/m^2) 
    117          &  zmax(3) > 1.E-3_wp .OR.   &             ! too large net freshwater flux ( kg/m^2/s) 
    118          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    119  
    120          !! We are 1D so no need to find a spatial location of the rogue point. 
    121  
     141      !                                   !==               error handling               ==! 
     142      !                                   !==  done by all processes at every time step  ==! 
     143      ! 
     144      IF(   zmax(1) >    5._wp .OR.   &                   ! too large wind stress         ( > 5 N/m^2 ) 
     145         &  zmax(2) > 2000._wp .OR.   &                   ! too large non-solar heat flux ( > 2000 W/m^2 ) 
     146         &  zmax(3) > 1.E-3_wp .OR.   &                   ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 
     147         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     148         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     149         ! 
     150         iloc(:,:) = 0 
     151         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     152            ! first: close the netcdf file, so we can read it 
     153            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     154            ! get global loc on the min/max 
     155            CALL mpp_maxloc( 'stpctl',    taum(:,:)  , tmask(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     156            CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), tmask(:,:,1), zzz, iloc(1:2,2) ) 
     157            CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), tmask(:,:,1), zzz, iloc(1:2,3) ) 
     158            ! find which subdomain has the max. 
     159            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     160            DO ji = 1, 4 
     161               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     162                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     163               ENDIF 
     164            END DO 
     165            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     166            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     167            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     168         ELSE                    ! find local min and max locations: 
     169            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     170            iloc(1:2,1) = MAXLOC(     taum(:,:)  , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     171            iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     172            iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     173            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     174         ENDIF 
     175         ! 
    122176         WRITE(ctmp1,*) ' stp_ctl: |tau_mod| > 5 N/m2  or  |qns| > 2000 W/m2  or |emp| > 1.E-3 or  NaN encounter in the tests' 
    123          WRITE(ctmp2,9500) kt,   zmax(1), zmax(2), zmax(3) 
    124          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    125  
     177         CALL wrt_line( ctmp2, kt, '|tau| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     178         CALL wrt_line( ctmp3, kt, '|qns| max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     179         CALL wrt_line( ctmp4, kt, 'emp   max',  zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     180         IF( Agrif_Root() ) THEN 
     181            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     182         ELSE 
     183            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     184         ENDIF 
     185         ! 
    126186         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    127  
    128          IF( .NOT. sn_cfctl%l_glochk ) THEN 
    129             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    130             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 
    131          ELSE 
    132             CALL ctl_stop( ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 
    133          ENDIF 
    134  
    135          kindic = -3 
    136          ! 
     187         ! 
     188         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     189            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     190            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     191            ENDIF 
     192         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     193            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     194         ENDIF 
     195         ! 
     196      ENDIF 
     197      ! 
     198      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     199         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     200         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
    137201      ENDIF 
    138202      ! 
     
    140204      ! 
    141205   END SUBROUTINE stp_ctl 
     206 
     207 
     208   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     209      !!---------------------------------------------------------------------- 
     210      !!                     ***  ROUTINE wrt_line  *** 
     211      !! 
     212      !! ** Purpose :   write information line 
     213      !! 
     214      !!---------------------------------------------------------------------- 
     215      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     216      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     217      REAL(wp),              INTENT(in   ) ::   pval 
     218      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     219      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     220      ! 
     221      CHARACTER(len=80) ::   clsuff 
     222      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     223      CHARACTER(len=9 ) ::   cli, clj, clk 
     224      CHARACTER(len=1 ) ::   clfmt 
     225      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     226      INTEGER           ::   ifmtk 
     227      !!---------------------------------------------------------------------- 
     228      WRITE(clkt , '(i9)') kt 
     229       
     230      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     231      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     232      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     233      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     234      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     235                                   WRITE(clmax, cl4) kmax-1 
     236      ! 
     237      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     238      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     239      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     240      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     241      ! 
     242      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     243      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     244      ENDIF 
     245      IF(kloc(3) == 0) THEN 
     246         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     247         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     248         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     249      ELSE 
     250         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     251         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     252         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     253         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     254      ENDIF 
     255      ! 
     2569100  FORMAT('MPI rank ', a) 
     2579200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2589300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2599400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     260      ! 
     261   END SUBROUTINE wrt_line 
     262 
    142263 
    143264   !!====================================================================== 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/README.md

    r12031 r13159  
    11 
    22## WARNING: TOTALLY-ALPHA-STUFF / DOCUMENT IN THE PROCESS OF BEING WRITEN! 
     3 
     4NOTE: if working with the trunk of NEMO, you are strongly advised to use the same test-case but on the `NEMO-examples` GitHub depo: 
     5https://github.com/NEMO-ocean/NEMO-examples/tree/master/STATION_ASF 
     6 
    37 
    48# *Station Air-Sea Fluxes* demonstration case 
Note: See TracChangeset for help on using the changeset viewer.