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 6004 for branches/2015 – NEMO

Changeset 6004 for branches/2015


Ignore:
Timestamp:
2015-12-04T17:05:58+01:00 (8 years ago)
Author:
gm
Message:

#1613: vvl by default, step III: Merge with the trunk (free surface simplification) (see wiki)

Location:
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM
Files:
4 deleted
144 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r5904 r6004  
    7171/ 
    7272!----------------------------------------------------------------------- 
    73 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    74 !----------------------------------------------------------------------- 
    75    ln_bt_nn_auto =    .FALSE.          !  Set nn_baro automatically to be just below 
    76                                        !  a user defined maximum courant number (rn_bt_cmax) 
    77    nn_baro       =    30               !  Number of iterations of barotropic mode 
    78 / 
    79 !----------------------------------------------------------------------- 
    8073&namcrs        !   Grid coarsening for dynamics output and/or 
    8174               !   passive tracer coarsened online simulations 
     
    9992   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
    10093   ln_apr_dyn  = .false.    !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    101    ln_traqsr   = .false.   !  Light penetration (T) or not (F) 
    10294 
    10395/ 
     
    137129&namtra_qsr    !   penetrative solar radiation 
    138130!----------------------------------------------------------------------- 
     131   ln_traqsr   = .false.   !  Light penetration (T) or not (F) 
    139132   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0) 
    140133/ 
     
    256249/ 
    257250!----------------------------------------------------------------------- 
    258 &nambbc        !   bottom temperature boundary condition 
    259 !----------------------------------------------------------------------- 
    260    ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
     251&nambbc        !   bottom temperature boundary condition                (default: NO) 
     252!----------------------------------------------------------------------- 
    261253/ 
    262254!----------------------------------------------------------------------- 
     
    343335/ 
    344336!----------------------------------------------------------------------- 
    345 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    346 !----------------------------------------------------------------------- 
    347 !                          !  explicit free surface                     ("key_dynspg_exp") 
    348 !                          !  filtered free surface                     ("key_dynspg_flt") 
    349 !                          !  split-explicit free surface               ("key_dynspg_ts") 
    350  
     337&namdyn_spg    !   surface pressure gradient  
     338!----------------------------------------------------------------------- 
     339   ln_dynspg_ts = .true.    ! split-explicit free surface 
     340      ln_bt_auto    = .false.  ! Number of sub-step defined from: 
     341         nn_baro       = 30       ! =F : the number of sub-step in rn_rdt seconds 
     342/ 
    351343!----------------------------------------------------------------------- 
    352344&namdyn_ldf    !   lateral diffusion on momentum 
     
    407399/ 
    408400!----------------------------------------------------------------------- 
    409 &namsol        !   elliptic solver / island / free surface 
    410 !----------------------------------------------------------------------- 
    411 / 
    412 !----------------------------------------------------------------------- 
    413401&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    414402!----------------------------------------------------------------------- 
     
    458446!----------------------------------------------------------------------- 
    459447/ 
    460 !----------------------------------------------------------------------- 
    461 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    462 !----------------------------------------------------------------------- 
    463 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm

    r5866 r6004  
    1  bld::tool::fppkeys  key_bdy key_tide key_dynspg_ts  key_zdfgls key_diainstant key_mpp_mpi key_iomput 
     1 bld::tool::fppkeys  key_bdy key_tide key_zdfgls key_diainstant key_mpp_mpi key_iomput 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r5866 r6004  
    6565/ 
    6666!----------------------------------------------------------------------- 
    67 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    68 !----------------------------------------------------------------------- 
    69 / 
    70 !----------------------------------------------------------------------- 
    7167&namcrs        !   Grid coarsening for dynamics output and/or 
    7268               !   passive tracer coarsened online simulations 
     
    142138&namtra_qsr    !   penetrative solar radiation 
    143139!----------------------------------------------------------------------- 
     140!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     141!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     142   sn_chl      ='chlorophyll_PAPASTATION', -1    , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''       , '' 
    144143/ 
    145144!----------------------------------------------------------------------- 
     
    198197/ 
    199198!----------------------------------------------------------------------- 
    200 &nambbc        !   bottom temperature boundary condition 
    201 !----------------------------------------------------------------------- 
    202    ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    203    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
     199&nambbc        !   bottom temperature boundary condition                (default: NO) 
     200!----------------------------------------------------------------------- 
    204201/ 
    205202!----------------------------------------------------------------------- 
     
    262259/ 
    263260!----------------------------------------------------------------------- 
    264 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    265 !----------------------------------------------------------------------- 
     261&namdyn_spg    !   surface pressure gradient                            (default: NO spg) 
     262!----------------------------------------------------------------------- 
     263/ 
    266264!----------------------------------------------------------------------- 
    267265&namdyn_ldf    !   lateral diffusion on momentum 
     
    294292!----------------------------------------------------------------------- 
    295293   ln_tmx_itf  = .false.   !  ITF specific parameterisation 
    296 / 
    297 !----------------------------------------------------------------------- 
    298 &namsol        !   elliptic solver / island / free surface 
    299 !----------------------------------------------------------------------- 
    300    nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    301    nn_nmin     =    210    !  minimum of iterations for the SOR solver 
    302    rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    303294/ 
    304295!----------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg

    r5866 r6004  
    6464   ppkth2      =  999999.0               ! 
    6565   ppacr2      =  999999.0               ! 
    66 / 
    67 !----------------------------------------------------------------------- 
    68 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    69 !----------------------------------------------------------------------- 
    7066/ 
    7167!----------------------------------------------------------------------- 
     
    286282/ 
    287283!----------------------------------------------------------------------- 
    288 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    289 !----------------------------------------------------------------------- 
    290  
     284&namdyn_spg    !   surface pressure gradient  
     285!----------------------------------------------------------------------- 
     286   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     287/ 
    291288!----------------------------------------------------------------------- 
    292289&namdyn_ldf    !   lateral diffusion on momentum 
     
    341338/ 
    342339!----------------------------------------------------------------------- 
    343 &namsol        !   elliptic solver / island / free surface 
    344 !----------------------------------------------------------------------- 
    345    nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    346    nn_nmin     =    210    !  minimum of iterations for the SOR solver 
    347    rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    348 / 
    349 !----------------------------------------------------------------------- 
    350340&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    351341!----------------------------------------------------------------------- 
     
    411401!----------------------------------------------------------------------- 
    412402/ 
    413 !----------------------------------------------------------------------- 
    414 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    415 !----------------------------------------------------------------------- 
    416    ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
    417 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm

    r5836 r6004  
    1  bld::tool::fppkeys key_dynspg_flt key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r5866 r6004  
    6969/ 
    7070!----------------------------------------------------------------------- 
    71 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    72 !----------------------------------------------------------------------- 
    73 / 
    74 !----------------------------------------------------------------------- 
    7571&namcrs        !   Grid coarsening for dynamics output and/or 
    7672               !   passive tracer coarsened online simulations 
     
    186182/ 
    187183!----------------------------------------------------------------------- 
    188 &nambbc        !   bottom temperature boundary condition 
    189 !----------------------------------------------------------------------- 
    190    ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    191    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
     184&nambbc        !   bottom temperature boundary condition                (default: NO) 
     185!----------------------------------------------------------------------- 
    192186/ 
    193187!----------------------------------------------------------------------- 
     
    287281/ 
    288282!----------------------------------------------------------------------- 
    289 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    290 !----------------------------------------------------------------------- 
     283&namdyn_spg    !   surface pressure gradient 
     284!----------------------------------------------------------------------- 
     285   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     286/ 
    291287!----------------------------------------------------------------------- 
    292288&namdyn_ldf    !   lateral diffusion on momentum 
     
    345341/ 
    346342!----------------------------------------------------------------------- 
    347 &namsol        !   elliptic solver / island / free surface 
    348 !----------------------------------------------------------------------- 
    349    nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    350    nn_nmin     =    210    !  minimum of iterations for the SOR solver 
    351    rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    352 / 
    353 !----------------------------------------------------------------------- 
    354343&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    355344!----------------------------------------------------------------------- 
     
    399388!----------------------------------------------------------------------- 
    400389/ 
    401 !----------------------------------------------------------------------- 
    402 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    403 !----------------------------------------------------------------------- 
    404    ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
    405 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm

    r5836 r6004  
    1 bld::tool::fppkeys key_dynspg_flt key_zdftke key_top key_my_trc key_mpp_mpi key_iomput 
     1bld::tool::fppkeys key_zdftke key_top key_my_trc key_mpp_mpi key_iomput 
    22inc $BFMDIR/src/nemo/bfm.fcm 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

    r5866 r6004  
    5959/ 
    6060!----------------------------------------------------------------------- 
    61 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    62 !----------------------------------------------------------------------- 
    63 / 
    64 !----------------------------------------------------------------------- 
    6561&namcrs        !   Grid coarsening for dynamics output and/or 
    6662               !   passive tracer coarsened online simulations 
     
    109105/ 
    110106!----------------------------------------------------------------------- 
    111 &nambbc        !   bottom temperature boundary condition 
    112 !----------------------------------------------------------------------- 
    113    ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    114    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
     107&nambbc        !   bottom temperature boundary condition                (default: NO) 
     108!----------------------------------------------------------------------- 
    115109/ 
    116110!----------------------------------------------------------------------- 
     
    206200/ 
    207201!----------------------------------------------------------------------- 
     202&namdyn_spg    !   surface pressure gradient 
     203!----------------------------------------------------------------------- 
     204   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     205/ 
     206!----------------------------------------------------------------------- 
    208207&namdyn_ldf    !   lateral diffusion on momentum 
    209208!----------------------------------------------------------------------- 
     
    244243/ 
    245244!----------------------------------------------------------------------- 
    246 &namsol        !   elliptic solver / island / free surface 
    247 !----------------------------------------------------------------------- 
    248    nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    249    nn_nmin     =    210    !  minimum of iterations for the SOR solver 
    250    rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    251 / 
    252 !----------------------------------------------------------------------- 
    253245&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    254246!----------------------------------------------------------------------- 
     
    266258!----------------------------------------------------------------------- 
    267259/ 
    268 !----------------------------------------------------------------------- 
    269 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    270 !----------------------------------------------------------------------- 
    271    ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
    272 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm

    r5836 r6004  
    1 bld::tool::fppkeys  key_dynspg_flt key_zdftke key_top key_pisces_reduced key_mpp_mpi 
     1bld::tool::fppkeys key_zdftke key_top key_pisces_reduced key_mpp_mpi 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg

    r5866 r6004  
    4141   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file 
    4242   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0) 
    43 !   nn_baro     =   60      !  number of barotropic time step            ("key_dynspg_ts") 
    4443   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1) 
    4544   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1) 
     
    175174/ 
    176175!----------------------------------------------------------------------- 
    177 &nambbc        !   bottom temperature boundary condition 
    178 !----------------------------------------------------------------------- 
    179    ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    180    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
     176&nambbc        !   bottom temperature boundary condition                (default: NO) 
     177!----------------------------------------------------------------------- 
    181178/ 
    182179!----------------------------------------------------------------------- 
     
    261258/ 
    262259!----------------------------------------------------------------------- 
    263 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    264 !----------------------------------------------------------------------- 
     260&namdyn_spg    !   surface pressure gradient 
     261!----------------------------------------------------------------------- 
     262   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     263/ 
    265264!----------------------------------------------------------------------- 
    266265&namdyn_ldf    !   lateral diffusion on momentum 
     
    300299/ 
    301300!----------------------------------------------------------------------- 
    302 &namsol        !   elliptic solver / island / free surface 
    303 !----------------------------------------------------------------------- 
    304    nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    305    nn_nmin     =    210    !  minimum of iterations for the SOR solver 
    306    rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    307 / 
    308 !----------------------------------------------------------------------- 
    309301&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    310302!----------------------------------------------------------------------- 
     
    354346!----------------------------------------------------------------------- 
    355347/ 
    356 !----------------------------------------------------------------------- 
    357 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    358 !----------------------------------------------------------------------- 
    359    ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
    360 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm

    r5836 r6004  
    1  bld::tool::fppkeys key_dynspg_flt key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg

    r5866 r6004  
    127127/ 
    128128!----------------------------------------------------------------------- 
    129 &nambbc        !   bottom temperature boundary condition 
    130 !----------------------------------------------------------------------- 
     129&nambbc        !   bottom temperature boundary condition                (default: NO) 
     130!----------------------------------------------------------------------- 
     131   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    131132/ 
    132133!----------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg

    r5866 r6004  
    103103/ 
    104104!----------------------------------------------------------------------- 
    105 &nambbc        !   bottom temperature boundary condition 
    106 !----------------------------------------------------------------------- 
     105&nambbc        !   bottom temperature boundary condition                (default: NO) 
     106!----------------------------------------------------------------------- 
     107   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    107108/ 
    108109!----------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm

    r5866 r6004  
    1 bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_zdftke key_zdfddm key_zdftmx  key_mpp_mpi key_iomput key_nosignedzero 
     1bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx  key_mpp_mpi key_iomput key_nosignedzero 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg

    r5866 r6004  
    5656/ 
    5757!----------------------------------------------------------------------- 
    58 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    59 !----------------------------------------------------------------------- 
    60 / 
    61 !----------------------------------------------------------------------- 
    6258&namcrs        !   Grid coarsening for dynamics output and/or 
    6359               !   passive tracer coarsened online simulations 
     
    127123&nambbc        !   bottom temperature boundary condition 
    128124!----------------------------------------------------------------------- 
     125   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    129126/ 
    130127!----------------------------------------------------------------------- 
     
    205202/ 
    206203!----------------------------------------------------------------------- 
     204&namdyn_spg    !   surface pressure gradient 
     205!----------------------------------------------------------------------- 
     206   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     207/ 
     208!----------------------------------------------------------------------- 
    207209&namdyn_ldf    !   lateral diffusion on momentum 
    208210!----------------------------------------------------------------------- 
     
    246248/ 
    247249!----------------------------------------------------------------------- 
    248 &namsol        !   elliptic solver / island / free surface  
    249 !----------------------------------------------------------------------- 
    250 / 
    251 !----------------------------------------------------------------------- 
    252250&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    253251!----------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg

    r5883 r6004  
    5353/ 
    5454!----------------------------------------------------------------------- 
    55 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    56 !----------------------------------------------------------------------- 
    57 / 
    58 !----------------------------------------------------------------------- 
    5955&namcrs        !   Grid coarsening for dynamics output and/or 
    6056               !   passive tracer coarsened online simulations 
     
    10298/ 
    10399!----------------------------------------------------------------------- 
    104 &nambbc        !   bottom temperature boundary condition 
    105 !----------------------------------------------------------------------- 
     100&nambbc        !   bottom temperature boundary condition                (default: NO) 
     101!----------------------------------------------------------------------- 
     102   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    106103/ 
    107104!----------------------------------------------------------------------- 
     
    190187&namdyn_hpg    !   Hydrostatic pressure gradient option 
    191188!----------------------------------------------------------------------- 
    192    ln_hpg_zco  = .false.   !  z-coordinate - full steps 
    193    ln_hpg_zps  = .false.    !  z-coordinate - partial steps (interpolation) 
    194    ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    195    ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    196    ln_hpg_prj  = .true.   !  s-coordinate (Pressure Jacobian scheme) 
    197    ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    198                                  !           centered      time scheme  (F) 
     189   ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation) 
     190/ 
     191!----------------------------------------------------------------------- 
     192&namdyn_spg    !   surface pressure gradient 
     193!----------------------------------------------------------------------- 
     194   ln_dynspg_ts  = .true.  !  split-explicit free surface 
    199195/ 
    200196!----------------------------------------------------------------------- 
     
    241237/ 
    242238!----------------------------------------------------------------------- 
    243 &namsol        !   elliptic solver / island / free surface 
    244 !----------------------------------------------------------------------- 
    245 / 
    246 !----------------------------------------------------------------------- 
    247239&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    248240!----------------------------------------------------------------------- 
     
    262254/ 
    263255!----------------------------------------------------------------------- 
    264 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    265 !----------------------------------------------------------------------- 
    266 / 
    267 !----------------------------------------------------------------------- 
    268256&namobs       !  observation usage                                      ('key_diaobs') 
    269257!----------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm

    r5866 r6004  
    1  bld::tool::fppkeys key_trabbl key_lim3 key_dynspg_ts key_zdftke key_zdfddm key_zdftmx  key_mpp_mpi key_diaobs key_asminc key_iomput key_nosignedzero 
     1 bld::tool::fppkeys key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx  key_mpp_mpi key_diaobs key_asminc key_iomput key_nosignedzero 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg

    r5866 r6004  
    8585                           ! 
    8686   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0) 
    87    nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts") 
    8887   rn_atfp     =    0.1    !  asselin time filter parameter 
    8988   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k) 
     
    295294   rn_alphc    =    0.65   !  compute albedo between two extremes values  
    296295   rn_alphdi   =    0.72   !  (Pyane, 1972) 
     296/ 
     297!----------------------------------------------------------------------- 
     298&namsbc_wave   ! External fields from wave model 
     299!----------------------------------------------------------------------- 
     300!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     301!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     302   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , '' 
     303! 
     304   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    297305/ 
    298306 
     
    551559   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    552560   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    553    ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    554                                  !           centered      time scheme  (F) 
    555 / 
    556 !----------------------------------------------------------------------- 
    557 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    558 !----------------------------------------------------------------------- 
    559 !                          !  explicit free surface                     ("key_dynspg_exp") 
    560 !                          !  filtered free surface                     ("key_dynspg_flt") 
    561 !                          !  split-explicit free surface               ("key_dynspg_ts") 
    562  
     561/ 
     562!----------------------------------------------------------------------- 
     563&namdyn_spg    !   surface pressure gradient 
     564!----------------------------------------------------------------------- 
     565   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     566/ 
    563567!----------------------------------------------------------------------- 
    564568&namdyn_ldf    !   lateral diffusion on momentum 
     
    701705!!   nammpp_dyndist    Massively Parallel domain decomposition          ("key_agrif" && "key_mpp_dyndist") 
    702706!!   namctl            Control prints & Benchmark 
    703 !!   namsol            elliptic solver / island / free surface  
    704 !!====================================================================== 
    705 ! 
    706 !----------------------------------------------------------------------- 
    707 &namsol        !   elliptic solver / island / free surface  
    708 !----------------------------------------------------------------------- 
    709    nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    710                            !                   =2 successive-over-relaxation (sor) 
    711    nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test 
    712    rn_eps      =  1.e-6    !  absolute precision of the solver 
    713    nn_nmin     =    300    !  minimum of iterations for the SOR solver 
    714    nn_nmax     =    800    !  maximum of iterations for the SOR solver 
    715    nn_nmod     =     10    !  frequency of test for the SOR solver 
    716    rn_resmax   =  1.e-10   !  absolute precision for the SOR solver 
    717    rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    718 / 
     707!!====================================================================== 
     708! 
    719709!----------------------------------------------------------------------- 
    720710&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
     
    898888    salfixmin = -9999      !  Minimum salinity after applying the increments 
    899889/ 
    900 !----------------------------------------------------------------------- 
    901 &namsbc_wave   ! External fields from wave model 
    902 !----------------------------------------------------------------------- 
    903 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
    904 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
    905    sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , '' 
    906 ! 
    907    cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    908 / 
    909 !----------------------------------------------------------------------- 
    910 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    911 !----------------------------------------------------------------------- 
    912    ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 
    913    ln_neptsimp       = .false.  ! yes/no use simplified neptune 
    914  
    915    ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep 
    916    rn_tslse          =  1.2e4   ! value of lengthscale L at the equator 
    917    rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole 
    918    ! Specify whether to ramp down the Neptune velocity in shallow 
    919    ! water, and if so the depth range controlling such ramping down 
    920    ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water 
    921    rn_htrmin         =  100.0   ! min. depth of transition range 
    922    rn_htrmax         =  200.0   ! max. depth of transition range 
    923 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg

    r5866 r6004  
    158158/ 
    159159!----------------------------------------------------------------------- 
    160 &nambbc        !   bottom temperature boundary condition 
     160&nambbc        !   bottom temperature boundary condition                (default: NO) 
    161161!-----------------------------------------------------------------------  
     162   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    162163/ 
    163164!----------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/cpp_ORCA2_LIM_CFC_C14b.fcm

    r5836 r6004  
    1 bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi 
     1bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg

    r5866 r6004  
    5050/ 
    5151!----------------------------------------------------------------------- 
    52 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    53 !----------------------------------------------------------------------- 
    54 / 
    55 !----------------------------------------------------------------------- 
    5652&namcrs        !   Grid coarsening for dynamics output and/or 
    5753               !   passive tracer coarsened online simulations 
     
    9995/ 
    10096!----------------------------------------------------------------------- 
    101 &nambbc        !   bottom temperature boundary condition 
    102 !----------------------------------------------------------------------- 
     97&nambbc        !   bottom temperature boundary condition                (default: NO) 
     98!----------------------------------------------------------------------- 
     99   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    103100/ 
    104101!----------------------------------------------------------------------- 
     
    190187/ 
    191188!----------------------------------------------------------------------- 
     189&namdyn_spg    !   surface pressure gradient 
     190!----------------------------------------------------------------------- 
     191   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     192/ 
     193!----------------------------------------------------------------------- 
    192194&namdyn_ldf    !   lateral diffusion on momentum 
    193195!----------------------------------------------------------------------- 
     
    230232/ 
    231233!----------------------------------------------------------------------- 
    232 &namsol        !   elliptic solver / island / free surface 
    233 !----------------------------------------------------------------------- 
    234 / 
    235 !----------------------------------------------------------------------- 
    236234&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    237235!----------------------------------------------------------------------- 
     
    249247!----------------------------------------------------------------------- 
    250248/ 
    251 !----------------------------------------------------------------------- 
    252 &namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
    253 !----------------------------------------------------------------------- 
    254 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm

    r5836 r6004  
    1 bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_mpp_mpi key_iomput 
     1bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_mpp_mpi key_iomput 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg

    r5866 r6004  
    5252/ 
    5353!----------------------------------------------------------------------- 
    54 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    55 !----------------------------------------------------------------------- 
    56 / 
    57 !----------------------------------------------------------------------- 
    5854&namcrs        !   Grid coarsening for dynamics output and/or 
    5955               !   passive tracer coarsened online simulations 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_SAS_LIM/cpp_ORCA2_SAS_LIM.fcm

    r5836 r6004  
    1  bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5883 r6004  
    66!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 
    77!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    8 !!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
     8!!                                    namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave) 
    99!!              4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) 
    1010!!              5 - bottom  boundary (nambfr, nambbc, nambbl) 
     
    1313!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx) 
    1414!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto) 
    15 !!             10 - miscellaneous    (namsol, nammpp, namctl) 
     15!!             10 - miscellaneous    (nammpp, namctl) 
    1616!!             11 - Obs & Assim      (namobs, nam_asminc) 
    1717!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    6161!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    6262!!   namdom       space and time domain (bathymetry, mesh, timestep) 
     63!!   namcrs       coarsened grid (for outputs and/or TOP)               ("key_crs") 
     64!!   namc1d       1D configuration options                              ("key_c1d") 
     65!!   namc1d_uvd   1D data (currents)                                    ("key_c1d") 
     66!!   namc1d_dyndmp 1D newtonian damping applied on currents             ("key_c1d") 
    6367!!   namtsd       data: temperature & salinity 
    6468!!====================================================================== 
     
    8791/ 
    8892!----------------------------------------------------------------------- 
    89 &namzgr        !   vertical coordinate 
     93&namzgr        !   vertical coordinate                                  (default: NO selection) 
    9094!----------------------------------------------------------------------- 
    9195   ln_zco      = .false.   !  z-coordinate - full    steps 
     
    98102&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate 
    99103!----------------------------------------------------------------------- 
    100    ln_s_sh94   = .true.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)| 
     104   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)| 
    101105   ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied 
    102106   ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch 
     
    164168/ 
    165169!----------------------------------------------------------------------- 
    166 &namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
    167 !----------------------------------------------------------------------- 
    168    ln_bt_fw      =    .TRUE.           !  Forward integration of barotropic equations 
    169    ln_bt_av      =    .TRUE.           !  Time filtering of barotropic variables 
    170    ln_bt_nn_auto =    .TRUE.           !  Set nn_baro automatically to be just below 
    171                                        !  a user defined maximum courant number (rn_bt_cmax) 
    172    nn_baro       =    30               !  Number of iterations of barotropic mode 
    173                                        !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F 
    174    rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T 
    175    nn_bt_flt     =    1                !  Time filter choice 
    176                                        !  = 0 None 
    177                                        !  = 1 Boxcar over   nn_baro barotropic steps 
    178                                        !  = 2 Boxcar over 2*nn_baro     "        " 
    179 / 
    180 !----------------------------------------------------------------------- 
    181 &namcrs        !   Grid coarsening for dynamics output and/or 
    182                !   passive tracer coarsened online simulations 
     170&namcrs        !   coarsened grid (for outputs and/or TOP)              ("key_crs") 
    183171!----------------------------------------------------------------------- 
    184172   nn_factx    = 3         !  Reduction factor of x-direction 
     
    202190/ 
    203191!----------------------------------------------------------------------- 
     192&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d") 
     193!----------------------------------------------------------------------- 
     194   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
     195/ 
     196!----------------------------------------------------------------------- 
     197&namc1d_uvd    !   data: U & V currents                                 ("key_c1d") 
     198!----------------------------------------------------------------------- 
     199!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     200!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     201   sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , '' 
     202   sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , '' 
     203! 
     204   cn_dir        = './'    !  root directory for the location of the files 
     205   ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F) 
     206   ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F) 
     207/ 
     208!----------------------------------------------------------------------- 
    204209&namtsd    !   data : Temperature  & Salinity 
    205210!----------------------------------------------------------------------- 
     
    213218   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
    214219/ 
     220 
    215221!!====================================================================== 
    216222!!            ***  Surface Boundary Condition namelists  *** 
    217223!!====================================================================== 
    218224!!   namsbc          surface boundary condition 
    219 !!   namsbc_ana      analytical         formulation 
    220 !!   namsbc_flx      flux               formulation 
    221 !!   namsbc_clio     CLIO bulk formulae formulation 
    222 !!   namsbc_core     CORE bulk formulae formulation 
    223 !!   namsbc_mfs      MFS  bulk formulae formulation 
    224 !!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3") 
     225!!   namsbc_ana      analytical         formulation                     (ln_ana     =T) 
     226!!   namsbc_flx      flux               formulation                     (ln_flx     =T) 
     227!!   namsbc_clio     CLIO bulk formulae formulation                     (ln_blk_clio=T) 
     228!!   namsbc_core     CORE bulk formulae formulation                     (ln_blk_core=T) 
     229!!   namsbc_mfs      MFS  bulk formulae formulation                     (ln_blk_mfs =T) 
     230!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3" ) 
    225231!!   namsbc_sas      StAndalone Surface module 
    226 !!   namtra_qsr      penetrative solar radiation 
    227 !!   namsbc_rnf      river runoffs 
    228 !!   namsbc_isf      ice shelf melting/freezing 
    229 !!   namsbc_apr      Atmospheric Pressure 
    230 !!   namsbc_ssr      sea surface restoring term (for T and/or S) 
     232!!   namtra_qsr      penetrative solar radiation                        (ln_traqsr  =T) 
     233!!   namsbc_rnf      river runoffs                                      (ln_rnf     =T) 
     234!!   namsbc_isf      ice shelf melting/freezing                         (nn_isf     >0) 
     235!!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T) 
     236!!   namsbc_ssr      sea surface restoring term (for T and/or S)        (ln_ssr     =T) 
    231237!!   namsbc_alb      albedo parameters 
     238!!   namsbc_wave     external fields from wave model                    (ln_wave    =T) 
     239!!   namberg         iceberg floats                                     ("key_") 
    232240!!====================================================================== 
    233241! 
     
    258266   nn_ice      = 2         !  =0 no ice boundary condition   , 
    259267                           !  =1 use observed ice-cover      , 
    260                            !  =2 ice-model used                         ("key_lim3" or "key_lim2") 
     268                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice") 
    261269   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    262270                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     
    321329&namsbc_core   !   namsbc_core  CORE bulk formulae 
    322330!----------------------------------------------------------------------- 
    323 !              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask ! 
    324 !              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      ! 
    325    sn_wndi     = 'u_10.15JUNE2009_fill'        ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Uwnd'   , '' 
    326    sn_wndj     = 'v_10.15JUNE2009_fill'        ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Vwnd'   , '' 
    327    sn_qsr      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    328    sn_qlw      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    329    sn_tair     = 't_10.15JUNE2009_fill'        ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    330    sn_humi     = 'q_10.15JUNE2009_fill'        ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    331    sn_prec     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    332    sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    333    sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     331!              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask ! 
     332!              !                              !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      ! 
     333   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Uwnd'   , '' 
     334   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Vwnd'   , '' 
     335   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     336   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     337   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     338   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     339   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     340   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
     341   sn_tdif     = 'taudif_core'                ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    334342 
    335343   cn_dir      = './'      !  root directory for the location of the bulk files 
    336344   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    337    rn_zqt      = 10.        !  Air temperature and humidity reference height (m) 
    338    rn_zu       = 10.        !  Wind vector reference height (m) 
     345   rn_zqt      = 10.       !  Air temperature and humidity reference height (m) 
     346   rn_zu       = 10.       !  Wind vector reference height (m) 
    339347   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    340348   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     
    345353&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae 
    346354!----------------------------------------------------------------------- 
    347 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights     ! rotation ! land/sea mask ! 
    348 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename    ! pairing  ! filename      ! 
    349    sn_wndi     =   'ecmwf'   ,        6          , 'u10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , '' 
    350    sn_wndj     =   'ecmwf'   ,        6          , 'v10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , '' 
    351    sn_clc      =   'ecmwf'   ,        6          , 'clc'     ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''       , '' 
    352    sn_msl      =   'ecmwf'   ,        6          , 'msl'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , '' 
    353    sn_tair     =   'ecmwf'   ,        6          , 't2'      ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , '' 
    354    sn_rhm      =   'ecmwf'   ,        6          , 'rh'      ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''       , '' 
    355    sn_prec     =   'ecmwf'   ,        6          , 'precip'  ,    .true.    , .true.  , 'daily'  ,'bicubic.nc' , ''       , '' 
     355!              !  file name  ! frequency (hours) ! variable ! time interp. !  clim  ! 'yearly'/ ! weights     ! rotation ! land/sea mask ! 
     356!              !             !  (if <0  months)  !   name   !   (logical)  !  (T/F) ! 'monthly' ! filename    ! pairing  ! filename      ! 
     357   sn_wndi     =   'ecmwf'   ,        6          , 'u10'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,  '' 
     358   sn_wndj     =   'ecmwf'   ,        6          , 'v10'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,  '' 
     359   sn_clc      =   'ecmwf'   ,        6          , 'clc'    ,    .true.    , .false., 'daily'   ,'bilinear.nc',   ''     ,  '' 
     360   sn_msl      =   'ecmwf'   ,        6          , 'msl'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,  '' 
     361   sn_tair     =   'ecmwf'   ,        6          , 't2'     ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,  '' 
     362   sn_rhm      =   'ecmwf'   ,        6          , 'rh'     ,    .true.    , .false., 'daily'   ,'bilinear.nc',   ''     ,  '' 
     363   sn_prec     =   'ecmwf'   ,        6          , 'precip' ,    .true.    , .true. , 'daily'   ,'bicubic.nc' ,   ''     ,  '' 
    356364 
    357365   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files 
     
    360368&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    361369!----------------------------------------------------------------------- 
    362 !                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
    363 !                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     370!                    !     description      !  multiple  !    vector   !      vector          ! vector ! 
     371!                    !                      ! categories !  reference  !    orientation       ! grids  ! 
    364372! send 
    365    sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
    366    sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
    367    sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
    368    sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
    369    sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
     373   sn_snd_temp   =   'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     374   sn_snd_alb    =   'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     375   sn_snd_thick  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
     376   sn_snd_crt    =   'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     377   sn_snd_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    370378! receive 
    371    sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    372    sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    373    sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
    374    sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    375    sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    376    sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    377    sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
    378    sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    379    sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    380    sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     379   sn_rcv_w10m   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     380   sn_rcv_taumod =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     381   sn_rcv_tau    =   'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     382   sn_rcv_dqnsdt =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     383   sn_rcv_qsr    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     384   sn_rcv_qns    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     385   sn_rcv_emp    =   'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     386   sn_rcv_rnf    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     387   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     388   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    381389! 
    382390   nn_cplmodel   =     1     !  Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     
    402410/ 
    403411!----------------------------------------------------------------------- 
    404 &namtra_qsr    !   penetrative solar radiation 
     412&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T) 
    405413!----------------------------------------------------------------------- 
    406414!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     
    419427/ 
    420428!----------------------------------------------------------------------- 
    421 &namsbc_rnf    !   runoffs namelist surface boundary condition 
     429&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T) 
    422430!----------------------------------------------------------------------- 
    423431!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     
    443451/ 
    444452!----------------------------------------------------------------------- 
    445 &namsbc_isf    !  Top boundary layer (ISF) 
    446 !----------------------------------------------------------------------- 
    447 !              ! file name ! frequency (hours) ! variable ! time interpol. ! clim   ! 'yearly'/ ! weights  ! rotation ! 
    448 !              !           !  (if <0  months)  !   name   !    (logical)   ! (T/F)  ! 'monthly' ! filename ! pairing  ! 
     453&namsbc_isf    !  Top boundary layer (ISF)                              (nn_isf >0) 
     454!----------------------------------------------------------------------- 
     455!              ! file name ! frequency (hours) ! variable ! time interp. ! clim   ! 'yearly'/ ! weights  ! rotation ! 
     456!              !           !  (if <0  months)  !   name   !   (logical)  ! (T/F)  ! 'monthly' ! filename ! pairing  ! 
    449457! nn_isf == 4 
    450    sn_qisf      = 'rnfisf' ,         -12      ,'sohflisf',    .false.      , .true. , 'yearly'  ,  ''      ,   '' 
    451    sn_fwfisf    = 'rnfisf' ,         -12      ,'sowflisf',    .false.      , .true. , 'yearly'  ,  ''      ,   '' 
     458   sn_qisf      = 'rnfisf' ,         -12       ,'sohflisf',    .false.   , .true. , 'yearly'  ,  ''      ,   '' 
     459   sn_fwfisf    = 'rnfisf' ,         -12       ,'sowflisf',    .false.   , .true. , 'yearly'  ,  ''      ,   '' 
    452460! nn_isf == 3 
    453    sn_rnfisf    = 'runoffs' ,         -12      ,'sofwfisf',    .false.      , .true. , 'yearly'  ,  ''      ,   '' 
     461   sn_rnfisf    = 'runoffs',         -12       ,'sofwfisf',    .false.   , .true. , 'yearly'  ,  ''      ,   '' 
    454462! nn_isf == 2 and 3 
    455    sn_depmax_isf = 'runoffs' ,       -12        ,'sozisfmax' ,   .false.  , .true. , 'yearly'  ,  ''      ,   '' 
    456    sn_depmin_isf = 'runoffs' ,       -12        ,'sozisfmin' ,   .false.  , .true. , 'yearly'  ,  ''      ,   '' 
     463   sn_depmax_isf = 'runoffs',        -12       ,'sozisfmax',   .false.   , .true. , 'yearly'  ,  ''      ,   '' 
     464   sn_depmin_isf = 'runoffs',        -12       ,'sozisfmin',   .false.   , .true. , 'yearly'  ,  ''      ,   '' 
    457465! nn_isf == 2 
    458    sn_Leff_isf = 'rnfisf' ,       0          ,'Leff'         ,   .false.  , .true.  , 'yearly'  ,  ''      ,   '' 
     466   sn_Leff_isf = 'rnfisf'  ,           0       ,'Leff'    ,    .false.   , .true. , 'yearly'  ,  ''      ,   '' 
     467 
    459468! for all case 
    460    ln_divisf   = .true.  ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?) 
     469   ln_divisf   = .true.   ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?) 
    461470! only for nn_isf = 1 or 2 
    462    rn_gammat0  = 1.0e-4   ! gammat coefficient used in blk formula 
    463    rn_gammas0  = 1.0e-4   ! gammas coefficient used in blk formula 
     471   rn_gammat0  = 1.e-4    ! gammat coefficient used in blk formula 
     472   rn_gammas0  = 1.e-4    ! gammas coefficient used in blk formula 
    464473! only for nn_isf = 1 
    465474   nn_isfblk   =  1       ! 1 ISOMIP ; 2 conservative (3 equation formulation, Jenkins et al. 1991 ??) 
    466    rn_hisf_tbl =  30.      ! thickness of the top boundary layer           (Losh et al. 2008) 
     475   rn_hisf_tbl =  30.     ! thickness of the top boundary layer           (Losh et al. 2008) 
    467476                          ! 0 => thickness of the tbl = thickness of the first wet cell 
    468477   ln_conserve = .true.   ! conservative case (take into account meltwater advection) 
     
    473482/ 
    474483!----------------------------------------------------------------------- 
    475 &namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk 
    476 !----------------------------------------------------------------------- 
    477 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    478 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    479    sn_apr      = 'patm'      ,         -1        ,'somslpre',    .true.     , .true. , 'yearly'  ,  ''      ,   ''     , '' 
     484&namsbc_apr    !   Atmospheric pressure forcing (in ocean or bulk)      (ln_apr_dyn=T) 
     485!----------------------------------------------------------------------- 
     486!              !  file name ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     487!              !            !  (if <0  months)  !   name    !  (logical)   !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     488   sn_apr      = 'patm'     ,         -1        ,'somslpre',    .true.     , .true. , 'yearly'  ,  ''      ,   ''     , '' 
    480489 
    481490   cn_dir      = './'       !  root directory for the location of the bulk files 
     
    485494/ 
    486495!----------------------------------------------------------------------- 
    487 &namsbc_ssr    !   surface boundary condition : sea surface restoring 
     496&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T) 
    488497!----------------------------------------------------------------------- 
    489498!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     
    511520/ 
    512521!----------------------------------------------------------------------- 
    513 &namberg       !   iceberg parameters 
    514 !----------------------------------------------------------------------- 
    515       ln_icebergs              = .false. 
     522&namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
     523!----------------------------------------------------------------------- 
     524!              !  file name  ! frequency (hours) ! variable    ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     525!              !             !  (if <0  months)  !   name      !  (logical)   !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     526   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff',     .true.   , .false., 'daily'   ,  ''      , ''       , '' 
     527   sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'    ,     .true.   , .false., 'daily'   ,  ''      , ''       , '' 
     528   sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'    ,     .true.   , .false., 'daily'   ,  ''      , ''       , '' 
     529   sn_wn       =  'sdw_wave' ,        1          , 'wave_num'  ,     .true.   , .false., 'daily'   ,  ''      , ''       , '' 
     530! 
     531   cn_dir_cdg  = './'      !  root directory for the location of drag coefficient files 
     532   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model 
     533   ln_sdw  = .false.       !  Computation of 3D stokes drift                
     534/ 
     535!----------------------------------------------------------------------- 
     536&namberg       !   iceberg parameters                                   (default: No iceberg) 
     537!----------------------------------------------------------------------- 
     538      ln_icebergs              = .false.              ! iceberg floats or not 
    516539      ln_bergdia               = .true.               ! Calculate budgets 
    517540      nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0 
     
    558581&namlbc        !   lateral momentum boundary condition 
    559582!----------------------------------------------------------------------- 
     583   !                       !  free slip  !   partial slip  !   no slip   ! strong slip 
    560584   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat 
    561                            !  free slip  !   partial slip  !   no slip   ! strong slip 
    562    ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs. 
     585   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs. 
    563586/ 
    564587!----------------------------------------------------------------------- 
     
    572595/ 
    573596!----------------------------------------------------------------------- 
    574 &nam_tide      !   tide parameters (#ifdef key_tide) 
     597&nam_tide      !   tide parameters                                      ("key_tide") 
    575598!----------------------------------------------------------------------- 
    576599   ln_tide_pot   = .true.   !  use tidal potential forcing 
     
    614637/ 
    615638!----------------------------------------------------------------------- 
    616 &nambdy_dta      !  open boundaries - external data           ("key_bdy") 
    617 !----------------------------------------------------------------------- 
    618 !              !  file name      ! frequency (hours) ! variable   ! time interp.  !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    619 !              !                 !  (if <0  months)  !   name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
    620    bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    621    bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    622    bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    623    bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    624    bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    625    bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    626    bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     639&nambdy_dta    !  open boundaries - external data                       ("key_bdy") 
     640!----------------------------------------------------------------------- 
     641!              !  file name      ! frequency (hours) ! variable  ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     642!              !                 !  (if <0  months)  !   name    !  (logical)   !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
     643   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     644   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     645   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     646   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     647   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     648   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     649   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    627650! for lim2 
    628 !   bn_frld  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    629 !   bn_hicif =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    630 !   bn_hsnif =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     651!   bn_frld  =   'amm12_bdyT_ice' ,         24        , 'ileadfra',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     652!   bn_hicif =   'amm12_bdyT_ice' ,         24        , 'iicethic',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     653!   bn_hsnif =   'amm12_bdyT_ice' ,         24        , 'isnowthi',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    631654! for lim3 
    632 !   bn_a_i  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    633 !   bn_ht_i =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    634 !   bn_ht_s =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    635    cn_dir  =    'bdydta/' 
    636    ln_full_vel = .false. 
     655!   bn_a_i  =    'amm12_bdyT_ice' ,         24        , 'ileadfra',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     656!   bn_ht_i =    'amm12_bdyT_ice' ,         24        , 'iicethic',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     657!   bn_ht_s =    'amm12_bdyT_ice' ,         24        , 'isnowthi',     .true.   , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     658 
     659   cn_dir      =    'bdydta/'   !  root directory for the location of the bulk files 
     660   ln_full_vel = .false.        !   
    637661/ 
    638662!----------------------------------------------------------------------- 
    639663&nambdy_tide     ! tidal forcing at open boundaries 
    640664!----------------------------------------------------------------------- 
    641    filtide          = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
    642    ln_bdytide_2ddta = .false. 
    643    ln_bdytide_conj  = .false. 
     665   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files 
     666   ln_bdytide_2ddta = .false.   ! 
     667   ln_bdytide_conj  = .false.   !  
    644668/ 
    645669!!====================================================================== 
     
    652676! 
    653677!----------------------------------------------------------------------- 
    654 &nambfr        !   bottom friction 
     678&nambfr        !   bottom friction                                      (default: linear) 
    655679!----------------------------------------------------------------------- 
    656680   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction 
     
    675699/ 
    676700!----------------------------------------------------------------------- 
    677 &nambbc        !   bottom temperature boundary condition 
    678 !----------------------------------------------------------------------- 
    679 !              !                              !  (if <0  months)  !   
    680 !              !  file name      ! frequency (hours) ! variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    681 !              !                 !  (if <0  months)  !   name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
    682    sn_qgh      ='geothermal_heating.nc',  -12.  , 'heatflow'      ,   .false.      , .true.  , 'yearly'  , ''       , ''       , '' 
     701&nambbc        !   bottom temperature boundary condition                (default: NO) 
     702!----------------------------------------------------------------------- 
     703!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     704!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
     705   sn_qgh      ='geothermal_heating.nc',  -12.       , 'heatflow',   .false.   , .true.  , 'yearly'  ,   ''     ,   ''     ,   '' 
    683706   ! 
    684    cn_dir      = './'      !  root directory for the location of the runoff files 
    685    ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
     707   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    686708   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
    687709                           !     = 1 constant flux 
    688710                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
    689711   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2] 
    690 / 
    691 !----------------------------------------------------------------------- 
    692 &nambbl        !   bottom boundary layer scheme 
     712   cn_dir      = './'      !  root directory for the location of the runoff files  
     713/ 
     714!----------------------------------------------------------------------- 
     715&nambbl        !   bottom boundary layer scheme                         ("key_trabbl") 
    693716!----------------------------------------------------------------------- 
    694717   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0) 
     
    729752/ 
    730753!----------------------------------------------------------------------- 
    731 &namtra_adv    !   advection scheme for tracer 
     754&namtra_adv    !   advection scheme for tracer                          (default: NO advection) 
    732755!----------------------------------------------------------------------- 
    733756   ln_traadv_cen =  .false.  !  2nd order centered scheme 
     
    746769/ 
    747770!----------------------------------------------------------------------- 
    748 &namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) 
     771&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO) 
    749772!----------------------------------------------------------------------- 
    750773   ln_mle    = .false.      ! (T) use the Mixed Layer Eddy (MLE) parameterisation 
     
    758781   rn_rho_c_mle  = 0.01    ! delta rho criterion used to calculate MLD for FK 
    759782/ 
    760 !---------------------------------------------------------------------------------- 
    761 &namtra_ldf    !   lateral diffusion scheme for tracers 
    762 !---------------------------------------------------------------------------------- 
     783!----------------------------------------------------------------------- 
     784&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion) 
     785!----------------------------------------------------------------------- 
    763786   !                       !  Operator type: 
    764787   !                           !  no diffusion: set ln_traldf_lap=..._blp=F  
     
    790813   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s] 
    791814/ 
    792 !---------------------------------------------------------------------------------- 
    793 &namtra_ldfeiv !   eddy induced velocity param. 
    794 !---------------------------------------------------------------------------------- 
    795    ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization 
    796    ln_ldfeiv_dia =.false.   ! diagnose eiv stream function and velocities 
    797    rn_aeiv_0     = 2000.    ! eddy induced velocity coefficient   [m2/s] 
    798    nn_aei_ijk_t  = 21       ! space/time variation of the eiv coeficient 
     815!----------------------------------------------------------------------- 
     816&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO) 
     817!----------------------------------------------------------------------- 
     818   ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization 
     819   ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities 
     820   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s] 
     821   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient 
    799822   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
    800823   !                                !   =  0           constant  
     
    805828/ 
    806829!----------------------------------------------------------------------- 
    807 &namtra_dmp    !   tracer: T & S newtonian damping 
     830&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
    808831!----------------------------------------------------------------------- 
    809832   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F) 
     
    811834                           !                   =1 no damping in the mixing layer (kz  criteria) 
    812835                           !                   =2 no damping in the mixed  layer (rho crieria) 
    813    cn_resto    = 'resto.nc' ! Name of file containing restoration coefficient field (use dmp_tools to create this) 
     836   cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this) 
    814837/ 
    815838 
     
    820843!!   namdyn_vor    advection scheme 
    821844!!   namdyn_hpg    hydrostatic pressure gradient 
    822 !!   namdyn_spg    surface pressure gradient                            (CPP key only) 
     845!!   namdyn_spg    surface pressure gradient 
    823846!!   namdyn_ldf    lateral diffusion scheme 
    824847!!====================================================================== 
    825848! 
    826849!----------------------------------------------------------------------- 
    827 &namdyn_adv    !   formulation of the momentum advection 
     850&namdyn_adv    !   formulation of the momentum advection                (default: vector form) 
    828851!----------------------------------------------------------------------- 
    829852   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
     
    834857/ 
    835858!----------------------------------------------------------------------- 
    836 &nam_vvl    !   vertical coordinate options 
     859&nam_vvl    !   vertical coordinate options                             (default: zstar) 
    837860!----------------------------------------------------------------------- 
    838861   ln_vvl_zstar  = .true.           !  zstar vertical coordinate 
     
    848871/ 
    849872!----------------------------------------------------------------------- 
    850 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
     873&namdyn_vor    !   option of physics/algorithm                          (default: NO) 
    851874!----------------------------------------------------------------------- 
    852875   ln_dynvor_ene = .false. !  enstrophy conserving scheme 
     
    854877   ln_dynvor_mix = .false. !  mixed scheme 
    855878   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    856       nn_een_e3f = 1             ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     879      nn_een_e3f = 1          ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    857880   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)  ! PLEASE DO NOT USE 
    858881/ 
    859882!----------------------------------------------------------------------- 
    860 &namdyn_hpg    !   Hydrostatic pressure gradient option 
     883&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps) 
    861884!----------------------------------------------------------------------- 
    862885   ln_hpg_zco  = .false.   !  z-coordinate - full steps 
     
    866889   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    867890   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    868    ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    869                                  !           centered      time scheme  (F) 
    870 / 
    871 !----------------------------------------------------------------------- 
    872 !namdyn_spg    !   surface pressure gradient   (CPP key only) 
    873 !----------------------------------------------------------------------- 
    874 !                          !  explicit free surface                     ("key_dynspg_exp") 
    875 !                          !  filtered free surface                     ("key_dynspg_flt") 
    876 !                          !  split-explicit free surface               ("key_dynspg_ts") 
    877  
    878 !----------------------------------------------------------------------- 
    879 &namdyn_ldf    !   lateral diffusion on momentum 
     891/ 
     892!----------------------------------------------------------------------- 
     893&namdyn_spg    !   surface pressure gradient                            (default: NO) 
     894!----------------------------------------------------------------------- 
     895   ln_dynspg_exp  = .false.   ! explicit free surface 
     896   ln_dynspg_ts   = .false.   ! split-explicit free surface 
     897      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs. 
     898      ln_bt_av      = .true.     ! Time filtering of barotropic variables 
     899         nn_bt_flt     = 1          ! Time filter choice  = 0 None 
     900         !                          !                     = 1 Boxcar over   nn_baro sub-steps 
     901         !                          !                     = 2 Boxcar over 2*nn_baro  "    " 
     902      ln_bt_auto    = .true.     ! Number of sub-step defined from: 
     903         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed 
     904         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds 
     905/ 
     906!----------------------------------------------------------------------- 
     907&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO) 
    880908!----------------------------------------------------------------------- 
    881909   !                       !  Type of the operator : 
     
    909937!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric") 
    910938!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke") 
     939!!    namzdf_gls    GLS vertical mixing                                 ("key_zdfgls") 
    911940!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm") 
    912941!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx") 
     
    10081037!!                  ***  Miscellaneous namelists  *** 
    10091038!!====================================================================== 
    1010 !!   namsol            elliptic solver / island / free surface 
    10111039!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    10121040!!   namctl            Control prints & Benchmark 
    1013 !!   namc1d            1D configuration options                         ("key_c1d") 
    1014 !!   namc1d_uvd        data: U & V currents                             ("key_c1d") 
    1015 !!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d") 
    10161041!!   namsto            Stochastic parametrization of EOS 
    10171042!!====================================================================== 
    10181043! 
    1019 !----------------------------------------------------------------------- 
    1020 &namsol        !   elliptic solver / island / free surface 
    1021 !----------------------------------------------------------------------- 
    1022    nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    1023                            !                   =2 successive-over-relaxation (sor) 
    1024    nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test 
    1025    rn_eps      =  1.e-6    !  absolute precision of the solver 
    1026    nn_nmin     =    300    !  minimum of iterations for the SOR solver 
    1027    nn_nmax     =    800    !  maximum of iterations for the SOR solver 
    1028    nn_nmod     =     10    !  frequency of test for the SOR solver 
    1029    rn_resmax   =  1.e-10   !  absolute precision for the SOR solver 
    1030    rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain) 
    1031 / 
    10321044!----------------------------------------------------------------------- 
    10331045&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
     
    10571069/ 
    10581070!----------------------------------------------------------------------- 
    1059 &namc1d_uvd    !   data: U & V currents                                 ("key_c1d") 
    1060 !----------------------------------------------------------------------- 
    1061 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    1062 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    1063    sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , '' 
    1064    sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , '' 
    1065 ! 
    1066    cn_dir        = './'    !  root directory for the location of the files 
    1067    ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F) 
    1068    ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F) 
    1069 / 
    1070 !----------------------------------------------------------------------- 
    1071 &namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d") 
    1072 !----------------------------------------------------------------------- 
    1073    ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
    1074 / 
    1075 !----------------------------------------------------------------------- 
    1076 &namsto       ! Stochastic parametrization of EOS 
    1077 !----------------------------------------------------------------------- 
    1078    ln_rststo = .false.           ! start from mean parameter (F) or from restart file (T) 
     1071&namsto       ! Stochastic parametrization of EOS                       (default: NO) 
     1072!----------------------------------------------------------------------- 
     1073   ln_sto_eos   = .false.  ! stochastic equation of state 
     1074   nn_sto_eos   = 1        ! number of independent random walks 
     1075   rn_eos_stdxy = 1.4      ! random walk horz. standard deviation (in grid points) 
     1076   rn_eos_stdz  = 0.7      ! random walk vert. standard deviation (in grid points) 
     1077   rn_eos_tcor  = 1440.    ! random walk time correlation (in timesteps) 
     1078   nn_eos_ord   = 1        ! order of autoregressive processes 
     1079   nn_eos_flt   = 0        ! passes of Laplacian filter 
     1080   rn_eos_lim   = 2.0      ! limitation factor (default = 3.0) 
     1081   ln_rststo    = .false.  ! start from mean parameter (F) or from restart file (T) 
    10791082   ln_rstseed = .true.           ! read seed of RNG from restart file 
    10801083   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input) 
    10811084   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output) 
    1082  
    1083    ln_sto_eos = .false.          ! stochastic equation of state 
    1084    nn_sto_eos = 1                ! number of independent random walks 
    1085    rn_eos_stdxy = 1.4            ! random walk horz. standard deviation (in grid points) 
    1086    rn_eos_stdz  = 0.7            ! random walk vert. standard deviation (in grid points) 
    1087    rn_eos_tcor  = 1440.0         ! random walk time correlation (in timesteps) 
    1088    nn_eos_ord  = 1               ! order of autoregressive processes 
    1089    nn_eos_flt  = 0               ! passes of Laplacian filter 
    1090    rn_eos_lim  = 2.0             ! limitation factor (default = 3.0) 
    10911085/ 
    10921086 
     
    10941088!!                  ***  Diagnostics namelists  *** 
    10951089!!====================================================================== 
    1096 !!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    10971090!!   namtrd       dynamics and/or tracer trends 
    10981091!!   namptr       Poleward Transport Diagnostics 
     1092!!   namhsb       Heat and salt budgets 
    10991093!!   namflo       float parameters                                      ("key_float") 
    1100 !!   namhsb       Heat and salt budgets 
    1101 !!====================================================================== 
    1102 ! 
    1103 !----------------------------------------------------------------------- 
    1104 &namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4") 
    1105 !----------------------------------------------------------------------- 
    1106    nn_nchunks_i=   4       !  number of chunks in i-dimension 
    1107    nn_nchunks_j=   4       !  number of chunks in j-dimension 
    1108    nn_nchunks_k=   31      !  number of chunks in k-dimension 
    1109                            !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 
    1110                            !  is optimal for postprocessing which works exclusively with horizontal slabs 
    1111    ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression 
    1112                            !  (F) ignore chunking information and produce netcdf3-compatible files 
    1113 / 
    1114 !----------------------------------------------------------------------- 
    1115 &namtrd        !   diagnostics on dynamics and/or tracer trends 
    1116 !              !       and/or mixed-layer trends and/or barotropic vorticity 
     1094!!   nam_diaharm  Harmonic analysis of tidal constituents               ('key_diaharm') 
     1095!!   namdct       transports through some sections 
     1096!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
     1097!!====================================================================== 
     1098! 
     1099!----------------------------------------------------------------------- 
     1100&namtrd        !   diagnostics on dynamics and/or tracer trends         (default F) 
     1101!              !   and/or mixed-layer trends and/or barotropic vorticity 
    11171102!----------------------------------------------------------------------- 
    11181103   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
    11191104   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output 
    1120    ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
    1121    ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet) 
     1105   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
     1106   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet) 
    11221107   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends 
    11231108   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends 
    1124    ln_tra_trd  = .FALSE.   ! (T) 3D tracer trend output 
     1109   ln_tra_trd  = .false.   ! (T) 3D tracer trend output 
    11251110   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 
    11261111   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step) 
     
    11331118!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
    11341119!!gm 
     1120!----------------------------------------------------------------------- 
     1121&namptr       !   Poleward Transport Diagnostic                         (default F) 
     1122!----------------------------------------------------------------------- 
     1123   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
     1124   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not 
     1125/ 
     1126!----------------------------------------------------------------------- 
     1127&namhsb       !  Heat and salt budgets                                  (default F) 
     1128!----------------------------------------------------------------------- 
     1129   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
     1130/ 
    11351131!----------------------------------------------------------------------- 
    11361132&namflo       !   float parameters                                      ("key_float") 
     
    11481144/ 
    11491145!----------------------------------------------------------------------- 
    1150 &namptr       !   Poleward Transport Diagnostic 
    1151 !----------------------------------------------------------------------- 
    1152    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    1153    ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not 
    1154 / 
    1155 !----------------------------------------------------------------------- 
    1156 &namhsb       !  Heat and salt budgets                                  (default F) 
    1157 !----------------------------------------------------------------------- 
    1158    ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
    1159 / 
    1160 !----------------------------------------------------------------------- 
    1161 &nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm') 
     1146&nam_diaharm   !   Harmonic analysis of tidal constituents              ('key_diaharm') 
    11621147!----------------------------------------------------------------------- 
    11631148    nit000_han = 1         ! First time step used for harmonic analysis 
     
    11681153/ 
    11691154!----------------------------------------------------------------------- 
    1170 &namdct        ! transports through sections 
     1155&namdct        ! transports through some sections 
    11711156!----------------------------------------------------------------------- 
    11721157    nn_dct      = 15       !  time step frequency for transports computing 
     
    11761161                           !  0 < n : debug section number n 
    11771162/ 
    1178  
    1179 !!====================================================================== 
    1180 !!            ***  Observation & Assimilation namelists *** 
     1163!----------------------------------------------------------------------- 
     1164&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4") 
     1165!----------------------------------------------------------------------- 
     1166   nn_nchunks_i=   4       !  number of chunks in i-dimension 
     1167   nn_nchunks_j=   4       !  number of chunks in j-dimension 
     1168   nn_nchunks_k=   31      !  number of chunks in k-dimension 
     1169                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 
     1170                           !  is optimal for postprocessing which works exclusively with horizontal slabs 
     1171   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression 
     1172                           !  (F) ignore chunking information and produce netcdf3-compatible files 
     1173/ 
     1174 
     1175!!====================================================================== 
     1176!!               ***  Observation & Assimilation  *** 
    11811177!!====================================================================== 
    11821178!!   namobs       observation and model comparison                      ('key_diaobs') 
     
    12051201   ln_velavcur= .false     ! Logical switch for velocity daily av. cur. 
    12061202   ln_velhrcur= .false     ! Logical switch for velocity high freq. cur. 
    1207    ln_velavadcp = .false.  ! Logical switch for velocity daily av. ADCP 
    1208    ln_velhradcp = .false.  ! Logical switch for velocity high freq. ADCP 
     1203   ln_velavadcp=.false.    ! Logical switch for velocity daily av. ADCP 
     1204   ln_velhradcp=.false.    ! Logical switch for velocity high freq. ADCP 
    12091205   ln_velfb   = .false.    ! Logical switch for feedback velocity data 
    1210    ln_grid_global = .false. ! Global distribtion of observations 
     1206   ln_grid_global=.false. ! Global distribtion of observations 
    12111207   ln_grid_search_lookup = .false. !  Logical switch for obs grid search w/lookup table 
    12121208   grid_search_file = 'grid_search'  !  Grid search lookup file header 
     
    12221218   sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names 
    12231219   seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names 
    1224    velavcurfiles = 'velavcurfile.nc'  ! Vel. cur. daily av. input file name 
    1225    velhrcurfiles = 'velhrcurfile.nc'  ! Vel. cur. high freq. input file name 
     1220   velavcurfiles  = 'velavcurfile.nc'  ! Vel. cur. daily av. input file name 
     1221   velhrcurfiles  = 'velhrcurfile.nc'  ! Vel. cur. high freq. input file name 
    12261222   velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name 
    12271223   velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name 
     
    12381234   ln_ignmis  = .true.     ! Logical switch for ignoring missing files 
    12391235   endailyavtypes = 820    ! ENACT daily average types - array (use namelist_cfg to set more values) 
    1240    ln_grid_global = .true. 
    1241    ln_grid_search_lookup = .false. 
    12421236/ 
    12431237!----------------------------------------------------------------------- 
     
    12591253    nn_divdmp = 0          !  Number of iterations of divergence damping operator 
    12601254/ 
    1261 !----------------------------------------------------------------------- 
    1262 &namsbc_wave   ! External fields from wave model 
    1263 !----------------------------------------------------------------------- 
    1264 !              !  file name  ! frequency (hours) ! variable     ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    1265 !              !             !  (if <0  months)  !   name       !   (logical)  !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      ! 
    1266    sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' ,     .true.   , .false. , 'daily'   ,  ''      , ''       , '' 
    1267    sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , '' 
    1268    sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , '' 
    1269    sn_wn       =  'sdw_wave' ,        1          , 'wave_num'   ,     .true.   , .false. , 'daily'   ,  ''      , ''       , '' 
    1270 ! 
    1271    cn_dir_cdg  = './'      !  root directory for the location of drag coefficient files 
    1272    ln_cdgw = .false.       !  Neutral drag coefficient read from wave model 
    1273    ln_sdw  = .false.       !  Computation of 3D stokes drift                
    1274 / 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r5866 r6004  
    2929   USE sbc_ice          ! surface boundary condition: ice 
    3030   USE sbc_oce          ! surface boundary condition: ocean 
    31    USE sbccpl 
     31   USE sbccpl           ! surface boundary condition: coupled interface 
    3232   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    3333   USE albedo           ! albedo parameters 
     34   ! 
    3435   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    3536   USE lib_mpp          ! MPP library 
     
    4344   PRIVATE 
    4445 
    45    PUBLIC   lim_sbc_init_2     ! called by ice_init_2 
    46    PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2 
    47    PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2 
     46   PUBLIC   lim_sbc_init_2   ! called by ice_init_2 
     47   PUBLIC   lim_sbc_flx_2    ! called by sbc_ice_lim_2 
     48   PUBLIC   lim_sbc_tau_2    ! called by sbc_ice_lim_2 
    4849 
    4950   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
     
    5253   REAL(wp)  ::   rone   = 1._wp       !     -      - 
    5354   ! 
    54    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0       ! fix SSS and ice salinity used in levitating case 0 
    5556   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2] 
    5657   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s] 
     
    101102      !!--------------------------------------------------------------------- 
    102103      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    103       !! 
     104      ! 
    104105      INTEGER  ::   ji, jj   ! dummy loop indices 
    105106      INTEGER  ::   ii0, ii1, ij0, ij1         ! local integers 
     
    113114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace 
    114115      !!--------------------------------------------------------------------- 
    115       
     116      ! 
    116117      CALL wrk_alloc( jpi, jpj, zqnsoce ) 
    117118      CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 
    118  
    119       SELECT CASE( nn_ice_embd )                 ! levitating or embedded sea-ice option 
    120         CASE( 0    )   ;   zswitch = 1           ! (0) standard levitating sea-ice : salt exchange only 
    121         CASE( 1, 2 )   ;   zswitch = 0           ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 
    122                                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure 
    123       END SELECT                                 !     
     119      ! 
     120      SELECT CASE( nn_ice_embd )             ! levitating or embedded sea-ice option 
     121         CASE( 0    )   ;   zswitch = 1         ! (0) old levitating sea-ice : salt exchange only 
     122         CASE( 1, 2 )   ;   zswitch = 0         ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 
     123         !                                      ! (2) embedded sea-ice : salt and volume fluxes and pressure 
     124      END SELECT 
    124125 
    125126      !------------------------------------------! 
     
    302303      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index 
    303304      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents 
    304       !! 
     305      ! 
    305306      INTEGER  ::   ji, jj   ! dummy loop indices 
    306307      REAL(wp) ::   zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt   ! local scalar 
     
    434435      !! ** input   : Namelist namicedia 
    435436      !!------------------------------------------------------------------- 
    436       ! 
    437       INTEGER :: jk           ! local integer 
     437      INTEGER ::   jk   ! local integer 
     438      !!------------------------------------------------------------------- 
    438439      ! 
    439440      IF(lwp) WRITE(numout,*) 
     
    471472!!gm I really don't like this staff here...  Find a way to put that elsewhere or differently 
    472473!!gm 
    473          IF( .NOT. ln_linssh ) THEN 
     474         IF( .NOT.ln_linssh ) THEN 
    474475 
    475476            do jk = 1,jpkm1                     ! adjust initial vertical scale factors 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r5845 r6004  
    1818   USE phycst           ! physical constants 
    1919   USE dom_oce          ! ocean space and time domain variables 
    20    USE domvvl 
    21    USE lbclnk 
     20   USE domvvl           ! ocean domain 
     21   USE ice_2            ! LIM sea-ice variables 
     22   USE sbc_oce          ! surface boundary condition: ocean 
     23   USE sbc_ice          ! surface boundary condition: sea-ice 
     24   USE thd_ice_2        ! LIM thermodynamic sea-ice variables 
     25   USE dom_ice_2        ! LIM sea-ice domain 
     26   USE limthd_zdf_2     ! 
     27   USE limthd_lac_2     ! 
     28   USE limtab_2         ! 
     29   ! 
    2230   USE in_out_manager   ! I/O manager 
    23    USE lib_mpp 
     31   USE lbclnk           ! 
     32   USE lib_mpp          ! 
    2433   USE wrk_nemo         ! work arrays 
    2534   USE iom              ! IOM library 
    26    USE ice_2            ! LIM sea-ice variables 
    27    USE sbc_oce          !  
    28    USE sbc_ice          !  
    29    USE thd_ice_2        ! LIM thermodynamic sea-ice variables 
    30    USE dom_ice_2        ! LIM sea-ice domain 
    31    USE limthd_zdf_2 
    32    USE limthd_lac_2 
    33    USE limtab_2 
    3435   USE prtctl           ! Print control 
    3536   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     
    4344   REAL(wp) ::   epsi16 = 1.e-16   ! 
    4445   REAL(wp) ::   epsi04 = 1.e-04   ! 
    45    REAL(wp) ::   rzero  = 0.e0     ! 
    46    REAL(wp) ::   rone   = 1.e0     ! 
     46   REAL(wp) ::   rzero  = 0._wp    ! 
     47   REAL(wp) ::   rone   = 1._wp    ! 
    4748 
    4849   !! * Substitutions 
     
    7475      !!--------------------------------------------------------------------- 
    7576      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    76       !! 
     77      ! 
    7778      INTEGER  ::   ji, jj               ! dummy loop indices 
    7879      INTEGER  ::   nbpb                 ! nb of icy pts for thermo. cal. 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5866 r6004  
    2323   !!   lim_sbc_tau   : update i- and j-stresses, and its modulus at the ocean surface 
    2424   !!---------------------------------------------------------------------- 
    25    USE par_oce          ! ocean parameters 
    26    USE phycst           ! physical constants 
    27    USE dom_oce          ! ocean domain 
    28    USE ice              ! LIM sea-ice variables 
    29    USE sbc_ice          ! Surface boundary condition: sea-ice fields 
    30    USE sbc_oce          ! Surface boundary condition: ocean fields 
    31    USE sbccpl 
    32    USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    33    USE albedo           ! albedo parameters 
    34    USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    35    USE lib_mpp          ! MPP library 
    36    USE wrk_nemo         ! work arrays 
    37    USE in_out_manager   ! I/O manager 
    38    USE prtctl           ! Print control 
    39    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    40    USE traqsr           ! add penetration of solar flux in the calculation of heat budget 
    41    USE iom 
    42    USE domvvl           ! Variable volume 
    43    USE limctl 
    44    USE limcons 
     25   USE par_oce        ! ocean parameters 
     26   USE oce     , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     27   USE phycst         ! physical constants 
     28   USE dom_oce        ! ocean domain 
     29   USE ice            ! LIM sea-ice variables 
     30   USE sbc_ice        ! Surface boundary condition: sea-ice fields 
     31   USE sbc_oce        ! Surface boundary condition: ocean fields 
     32   USE sbccpl         ! Surface boundary condition: coupled interface 
     33   USE albedo         ! albedo parameters 
     34   USE traqsr         ! add penetration of solar flux in the calculation of heat budget 
     35   USE domvvl         ! Variable volume 
     36   USE limctl         !  
     37   USE limcons        !  
     38   ! 
     39   USE in_out_manager ! I/O manager 
     40   USE iom            ! xIO server 
     41   USE lbclnk         ! ocean lateral boundary condition - MPP exchanges 
     42   USE lib_mpp        ! MPP library 
     43   USE wrk_nemo       ! work arrays 
     44   USE prtctl         ! Print control 
     45   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4546 
    4647   IMPLICIT NONE 
    4748   PRIVATE 
    4849 
    49    PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
     50   PUBLIC   lim_sbc_init   ! called by sbcice_lim 
    5051   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5152   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
     
    100101      !!              The ref should be Rousset et al., 2015 
    101102      !!--------------------------------------------------------------------- 
    102       INTEGER, INTENT(in) ::   kt                                  ! number of iteration 
    103       INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices 
    104       REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    105       REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean 
    106       ! 
    107       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
     103      INTEGER, INTENT(in) ::   kt   ! number of iteration 
     104      ! 
     105      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices 
     106      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     107      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
     108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace 
    108109      !!--------------------------------------------------------------------- 
    109  
     110      ! 
    110111      ! make calls for heat fluxes before it is modified 
    111112      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
     
    197198      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   ! 
    198199      !------------------------------------------------------------------------! 
    199       CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )     
     200      CALL wrk_alloc( jpi,jpj,jpl,  zalb_cs, zalb_os )     
    200201      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    201202      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    202       CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     203      CALL wrk_dealloc( jpi,jpj,jpl,  zalb_cs, zalb_os ) 
    203204 
    204205      ! conservation test 
    205       IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 
     206      IF( ln_limdiahsb )   CALL lim_cons_final( 'limsbc' ) 
    206207 
    207208      ! control prints 
    208209      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    209  
     210      ! 
    210211      IF(ln_ctl) THEN 
    211212         CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' ) 
     
    214215         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    215216      ENDIF 
    216  
     217      ! 
    217218   END SUBROUTINE lim_sbc_flx 
    218219 
     
    245246      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index 
    246247      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents 
    247       !! 
     248      ! 
    248249      INTEGER  ::   ji, jj   ! dummy loop indices 
    249250      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar 
     
    302303      !! ** input   : Namelist namicedia 
    303304      !!------------------------------------------------------------------- 
    304       INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
    305       REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar 
     305      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     306      REAL(wp) ::   zcoefu, zcoefv, zcoeff   ! local scalar 
     307      !!------------------------------------------------------------------- 
     308      ! 
    306309      IF(lwp) WRITE(numout,*) 
    307310      IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5845 r6004  
    2525   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2626   USE sbc_ice        ! Surface boundary condition: ice fields 
    27    USE thd_ice        ! LIM thermodynamic sea-ice variables 
    28    USE dom_ice        ! LIM sea-ice domain 
     27   USE dom_ice        ! LIM: sea-ice domain 
     28   USE thd_ice        ! LIM: thermodynamic sea-ice variables 
    2929   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3030   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
    3131   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    3232   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
    33    USE limthd_lac     ! LIM-3 lateral accretion 
    34    USE limitd_th      ! remapping thickness distribution 
     33   USE limthd_lac     ! LIM: lateral accretion 
     34   USE limitd_th      ! LIM: remapping thickness distribution 
    3535   USE limtab         ! LIM: 1D <==> 2D transformation 
    3636   USE limvar         ! LIM: sea-ice variables 
     37   USE limcons        ! LIM: conservation tests 
     38   USE limctl         ! LIM: control print 
     39   ! 
     40   USE in_out_manager ! I/O manager 
     41   USE prtctl         ! Print control 
    3742   USE lbclnk         ! lateral boundary condition - MPP links 
    3843   USE lib_mpp        ! MPP library 
    3944   USE wrk_nemo       ! work arrays 
    40    USE in_out_manager ! I/O manager 
    41    USE prtctl         ! Print control 
    4245   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4346   USE timing         ! Timing 
    44    USE limcons        ! conservation tests 
    45    USE limctl 
    4647 
    4748   IMPLICIT NONE 
     
    8081      !!--------------------------------------------------------------------- 
    8182      INTEGER, INTENT(in) :: kt    ! number of iteration 
    82       !! 
     83      ! 
    8384      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    8485      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
    85       INTEGER  :: ii, ij           ! temporary dummy loop index 
    8686      REAL(wp) :: zfric_u, zqld, zqfr 
    8787      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    8888      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    8989      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
    90       ! 
    9190      !!------------------------------------------------------------------- 
    9291 
    93       IF( nn_timing == 1 )  CALL timing_start('limthd') 
     92      IF( nn_timing == 1 )   CALL timing_start('limthd') 
    9493 
    9594      ! conservation test 
    96       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     95      IF( ln_limdiahsb )   CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
    9796 
    9897      CALL lim_var_glo2eqv 
     
    225224 
    226225         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    227  
    228             !-------------------------! 
    229             ! --- Move to 1D arrays --- 
    230             !-------------------------! 
    231             CALL lim_thd_1d2d( nbpb, jl, 1 ) 
    232  
    233             !--------------------------------------! 
    234             ! --- Ice/Snow Temperature profile --- ! 
    235             !--------------------------------------! 
    236             CALL lim_thd_dif( 1, nbpb ) 
    237  
    238             !---------------------------------! 
    239             ! --- Ice/Snow thickness ---      ! 
    240             !---------------------------------! 
    241             CALL lim_thd_dh( 1, nbpb )     
    242  
    243             ! --- Ice enthalpy remapping --- ! 
    244             CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  
    245                                              
    246             !---------------------------------! 
    247             ! --- Ice salinity ---            ! 
    248             !---------------------------------! 
    249             CALL lim_thd_sal( 1, nbpb )     
    250  
    251             !---------------------------------! 
    252             ! --- temperature update ---      ! 
    253             !---------------------------------! 
    254             CALL lim_thd_temp( 1, nbpb ) 
    255  
    256             !------------------------------------! 
    257             ! --- lateral melting if monocat --- ! 
    258             !------------------------------------! 
     226            ! 
     227            CALL lim_thd_1d2d( nbpb, jl, 1 )                ! --- Move to 1D arrays ---! 
     228            ! 
     229            CALL lim_thd_dif ( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- ! 
     230            ! 
     231            CALL lim_thd_dh  ( 1, nbpb )                    ! --- Ice/Snow thickness ---! 
     232            ! 
     233            CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- ! 
     234            ! 
     235            CALL lim_thd_sal ( 1, nbpb )                    ! --- Ice salinity ---            ! 
     236            ! 
     237            CALL lim_thd_temp( 1, nbpb )                    ! --- temperature update ---      ! 
     238            ! 
     239            !                                               ! --- lateral melting if monocat --- ! 
    259240            IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    260241               CALL lim_thd_lam( 1, nbpb ) 
    261242            END IF 
    262  
    263             !-------------------------! 
    264             ! --- Move to 2D arrays --- 
    265             !-------------------------! 
    266             CALL lim_thd_1d2d( nbpb, jl, 2 ) 
    267  
    268             ! 
    269             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     243            ! 
     244            CALL lim_thd_1d2d( nbpb, jl, 2 )                ! --- Move to 2D arrays --- 
     245            ! 
     246            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice )  !RB necessary ?? 
    270247         ENDIF 
    271248         ! 
     
    409386      ENDIF 
    410387      ! 
    411       IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    412  
     388      IF( nn_timing == 1 )   CALL timing_stop('limthd') 
     389      ! 
    413390   END SUBROUTINE lim_thd  
    414391 
     
    423400      !!------------------------------------------------------------------- 
    424401      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    425       !! 
     402      ! 
    426403      INTEGER  ::   ji, jk   ! dummy loop indices 
    427404      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
     
    443420         END DO  
    444421      END DO  
    445  
     422      ! 
    446423   END SUBROUTINE lim_thd_temp 
     424 
    447425 
    448426   SUBROUTINE lim_thd_lam( kideb, kiut ) 
     
    454432      !!----------------------------------------------------------------------- 
    455433      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop 
    456       INTEGER             ::   ji                 ! dummy loop indices 
    457       REAL(wp)            ::   zhi_bef            ! ice thickness before thermo 
    458       REAL(wp)            ::   zdh_mel, zda_mel   ! net melting 
    459       REAL(wp)            ::   zvi, zvs           ! ice/snow volumes  
    460  
     434      ! 
     435      INTEGER  ::   ji                 ! dummy loop indices 
     436      REAL(wp) ::   zhi_bef            ! ice thickness before thermo 
     437      REAL(wp) ::   zdh_mel, zda_mel   ! net melting 
     438      REAL(wp) ::   zvi, zvs           ! ice/snow volumes  
     439      !!----------------------------------------------------------------------- 
     440      ! 
    461441      DO ji = kideb, kiut 
    462442         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 
     
    476456         END IF 
    477457      END DO 
    478        
     458      ! 
    479459   END SUBROUTINE lim_thd_lam 
     460 
    480461 
    481462   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 
     
    485466      !! ** Purpose :   move arrays from 1d to 2d and the reverse 
    486467      !!----------------------------------------------------------------------- 
    487       INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D 
    488                                         ! 2= from 1D to 2D 
     468      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D 
    489469      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays 
    490470      INTEGER, INTENT(in) ::   jl       ! ice cat 
     471      ! 
    491472      INTEGER             ::   jk       ! dummy loop indices 
    492  
     473      !!----------------------------------------------------------------------- 
     474      ! 
    493475      SELECT CASE( kn ) 
    494  
    495       CASE( 1 ) 
    496  
     476      ! 
     477      CASE( 1 )            ! from 2D to 1D 
     478         ! 
    497479         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    498480         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    499481         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    500482         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    501           
     483         ! 
    502484         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    503485         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     
    511493            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    512494         END DO 
    513           
     495         ! 
    514496         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
    515497         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     
    525507         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
    526508         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
    527           
     509         ! 
    528510         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
    529511         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
    530           
     512         ! 
    531513         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    532514         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     
    535517         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
    536518         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    537           
     519         ! 
    538520         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    539521         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     
    542524         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    543525         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    544           
     526         ! 
    545527         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    546528         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     
    556538         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 
    557539         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
    558  
    559       CASE( 2 ) 
    560  
     540         ! 
     541      CASE( 2 )            ! from 1D to 2D 
     542         ! 
    561543         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
    562544         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
     
    575557         END DO 
    576558         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
    577           
     559         ! 
    578560         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
    579561         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
    580           
     562         ! 
    581563         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    582564         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     
    585567         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
    586568         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    587           
     569         ! 
    588570         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    589571         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     
    592574         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    593575         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    594           
     576         ! 
    595577         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    596578         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     
    611593         !          
    612594      END SELECT 
    613  
     595      ! 
    614596   END SUBROUTINE lim_thd_1d2d 
    615597 
     
    628610      !!------------------------------------------------------------------- 
    629611      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    630       NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       & 
    631          &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
     612      !! 
     613      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                & 
     614         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,  & 
    632615         &                nn_monocat, ln_it_qnsice 
    633616      !!------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r5845 r6004  
    2222   USE oce 
    2323   USE dom_oce       
    24    USE sol_oce 
     24   USE zdf_oce 
    2525   USE agrif_oce 
    2626   USE phycst 
     27   ! 
    2728   USE in_out_manager 
    2829   USE agrif_opa_sponge 
    2930   USE lib_mpp 
    3031   USE wrk_nemo 
    31    USE dynspg_oce 
    32    USE zdf_oce 
    3332  
    3433   IMPLICIT NONE 
    3534   PRIVATE 
    3635 
    37    INTEGER :: bdy_tinterp = 0 
    38  
    3936   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    40    PUBLIC   interpun, interpvn, interpun2d, interpvn2d  
     37   PUBLIC   interpun, interpvn 
    4138   PUBLIC   interptsn,  interpsshn 
    4239   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
     
    4643# endif 
    4744 
     45   INTEGER ::   bdy_tinterp = 0 
     46 
    4847#  include "vectopt_loop_substitute.h90" 
    4948   !!---------------------------------------------------------------------- 
    50    !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     49   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    5150   !! $Id$ 
    5251   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5352   !!---------------------------------------------------------------------- 
    54  
    5553CONTAINS 
    5654 
     
    6159      ! 
    6260      IF( Agrif_Root() )   RETURN 
    63  
    64       Agrif_SpecialValue    = 0.e0 
     61      ! 
     62      Agrif_SpecialValue    = 0._wp 
    6563      Agrif_UseSpecialValue = .TRUE. 
    66  
     64      ! 
    6765      CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 
     66      ! 
    6867      Agrif_UseSpecialValue = .FALSE. 
    6968      ! 
     
    7776      INTEGER, INTENT(in) ::   kt 
    7877      ! 
    79       INTEGER :: ji,jj,jk, j1,j2, i1,i2 
    80       REAL(wp) :: timeref 
    81       REAL(wp) :: z2dt, znugdt 
    82       REAL(wp) :: zrhox, zrhoy 
    83       REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 
    84       !!----------------------------------------------------------------------   
    85  
     78      INTEGER ::   ji, jj, jk       ! dummy loop indices 
     79      INTEGER ::   j1, j2, i1, i2 
     80      REAL(wp), POINTER, DIMENSION(:,:) ::   zub, zvb 
     81      !!----------------------------------------------------------------------   
     82      ! 
    8683      IF( Agrif_Root() )   RETURN 
    87  
    88       CALL wrk_alloc( jpi, jpj, spgv1, spgu1 ) 
    89  
    90       Agrif_SpecialValue=0. 
     84      ! 
     85      CALL wrk_alloc( jpi,jpj,   zub, zvb ) 
     86      ! 
     87      Agrif_SpecialValue    = 0._wp 
    9188      Agrif_UseSpecialValue = ln_spc_dyn 
    92  
    93       CALL Agrif_Bc_variable(un_interp_id,procname=interpun) 
    94       CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 
    95  
    96 #if defined key_dynspg_flt 
    97       CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d) 
    98       CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d) 
    99 #endif 
    100  
     89      ! 
     90      CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 
     91      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 
     92      ! 
    10193      Agrif_UseSpecialValue = .FALSE. 
    102  
    103       zrhox = Agrif_Rhox() 
    104       zrhoy = Agrif_Rhoy() 
    105  
    106       timeref = 1. 
    107       ! time step: leap-frog 
    108       z2dt = 2. * rdt 
    109       ! time step: Euler if restart from rest 
    110       IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 
    111       ! coefficients 
    112       znugdt =  grav * z2dt     
    113  
     94      ! 
    11495      ! prevent smoothing in ghost cells 
    115       i1=1 
    116       i2=jpi 
    117       j1=1 
    118       j2=jpj 
    119       IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3 
    120       IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2 
    121       IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3 
    122       IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2 
    123  
    124  
    125       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    126 #if defined key_dynspg_flt 
    127          DO jk=1,jpkm1 
     96      i1 =  1   ;   i2 = jpi 
     97      j1 =  1   ;   j2 = jpj 
     98      IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 3 
     99      IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj-2 
     100      IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 3 
     101      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2 
     102 
     103      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     104         ! 
     105         ! Smoothing 
     106         ! --------- 
     107         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     108            ua_b(2,:) = 0._wp 
     109            DO jk = 1, jpkm1 
     110               DO jj = 1, jpj 
     111                  ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     112               END DO 
     113            END DO 
     114            DO jj = 1, jpj 
     115               ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)             
     116            END DO 
     117         ENDIF 
     118         ! 
     119         DO jk=1,jpkm1                 ! Smooth 
    128120            DO jj=j1,j2 
    129                ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 
    130             END DO 
    131          END DO 
    132  
    133          spgu(2,:)=0. 
     121               ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
     122               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
     123            END DO 
     124         END DO 
     125         ! 
     126         zub(2,:) = 0._wp              ! Correct transport 
     127         DO jk = 1, jpkm1 
     128            DO jj = 1, jpj 
     129               zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     130            END DO 
     131         END DO 
     132         DO jj=1,jpj 
     133            zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
     134         END DO 
    134135 
    135136         DO jk=1,jpkm1 
    136137            DO jj=1,jpj 
    137                spgu(2,jj)=spgu(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 
    138             END DO 
    139          END DO 
    140  
    141          DO jj=1,jpj 
    142             IF (umask(2,jj,1).NE.0.) THEN 
    143                spgu(2,jj)=spgu(2,jj)*r1_hu_n(2,jj) 
    144             ENDIF 
    145          END DO 
    146 #else 
    147          spgu(2,:) = ua_b(2,:) 
    148 #endif 
    149  
    150          DO jk=1,jpkm1 
    151             DO jj=j1,j2 
    152                ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk)) 
    153                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
    154             END DO 
    155          END DO 
    156  
    157          spgu1(2,:)=0. 
    158  
    159          DO jk=1,jpkm1 
     138               ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 
     139            END DO 
     140         END DO 
     141 
     142         ! Set tangential velocities to time splitting estimate 
     143         !----------------------------------------------------- 
     144         IF( ln_dynspg_ts ) THEN 
     145            zvb(2,:) = 0._wp 
     146            DO jk = 1, jpkm1 
     147               DO jj = 1, jpj 
     148                  zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
     149               END DO 
     150            END DO 
     151            DO jj = 1, jpj 
     152               zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
     153            END DO 
     154            DO jk = 1, jpkm1 
     155               DO jj = 1, jpj 
     156                  va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
     157               END DO 
     158            END DO 
     159         ENDIF 
     160         ! 
     161         ! Mask domain edges: 
     162         !------------------- 
     163         DO jk = 1, jpkm1 
     164            DO jj = 1, jpj 
     165               ua(1,jj,jk) = 0._wp 
     166               va(1,jj,jk) = 0._wp 
     167            END DO 
     168         END DO          
     169         ! 
     170      ENDIF 
     171 
     172      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
     173 
     174         ! Smoothing 
     175         ! --------- 
     176         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     177            ua_b(nlci-2,:) = 0._wp 
     178            DO jk=1,jpkm1 
     179               DO jj=1,jpj 
     180                  ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
     181               END DO 
     182            END DO 
    160183            DO jj=1,jpj 
    161                spgu1(2,jj)=spgu1(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 
    162             END DO 
    163          END DO 
    164  
    165          DO jj=1,jpj 
    166             IF (umask(2,jj,1).NE.0.) THEN 
    167                spgu1(2,jj)=spgu1(2,jj)*r1_hu_n(2,jj) 
    168             ENDIF 
    169          END DO 
    170  
    171          DO jk=1,jpkm1 
    172             DO jj=j1,j2 
    173                ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk) 
    174             END DO 
    175          END DO 
    176  
    177 #if defined key_dynspg_ts 
     184               ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)             
     185            END DO 
     186         ENDIF 
     187 
     188         DO jk = 1, jpkm1              ! Smooth 
     189            DO jj = j1, j2 
     190               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
     191                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
     192            END DO 
     193         END DO 
     194 
     195         zub(nlci-2,:) = 0._wp        ! Correct transport 
     196         DO jk = 1, jpkm1 
     197            DO jj = 1, jpj 
     198               zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
     199            END DO 
     200         END DO 
     201         DO jj = 1, jpj 
     202            zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
     203         END DO 
     204 
     205         DO jk = 1, jpkm1 
     206            DO jj = 1, jpj 
     207               ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
     208            END DO 
     209         END DO 
     210         ! 
    178211         ! Set tangential velocities to time splitting estimate 
    179          spgv1(2,:)=0. 
    180          DO jk=1,jpkm1 
     212         !----------------------------------------------------- 
     213         IF( ln_dynspg_ts ) THEN 
     214            zvb(nlci-1,:) = 0._wp 
     215            DO jk = 1, jpkm1 
     216               DO jj = 1, jpj 
     217                  zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
     218               END DO 
     219            END DO 
    181220            DO jj=1,jpj 
    182                spgv1(2,jj)=spgv1(2,jj)+e3v_a(2,jj,jk)*va(2,jj,jk) 
    183             END DO 
    184          END DO 
    185          DO jj=1,jpj 
    186             spgv1(2,jj)=spgv1(2,jj)*r1_hv_a(2,jj) 
    187          END DO 
    188          DO jk=1,jpkm1 
    189             DO jj=1,jpj 
    190                va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-spgv1(2,jj))*vmask(2,jj,jk) 
    191             END DO 
    192          END DO 
    193 #endif 
    194  
    195       ENDIF 
    196  
    197       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    198 #if defined key_dynspg_flt 
    199          DO jk=1,jpkm1 
    200             DO jj=j1,j2 
    201                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 
    202             END DO 
    203          END DO 
    204          spgu(nlci-2,:)=0. 
    205          DO jk=1,jpkm1 
    206             DO jj=1,jpj 
    207                spgu(nlci-2,jj)=spgu(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
    208             ENDDO 
    209          ENDDO 
    210          DO jj=1,jpj 
    211             IF (umask(nlci-2,jj,1).NE.0.) THEN 
    212                spgu(nlci-2,jj)=spgu(nlci-2,jj)*r1_hu_n(nlci-2,jj) 
    213             ENDIF 
    214          END DO 
    215 #else 
    216          spgu(nlci-2,:) = ua_b(nlci-2,:) 
    217 #endif 
    218          DO jk=1,jpkm1 
    219             DO jj=j1,j2 
    220                ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 
    221  
    222                ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 
    223  
    224             END DO 
    225          END DO 
    226          spgu1(nlci-2,:)=0. 
    227          DO jk=1,jpkm1 
    228             DO jj=1,jpj 
    229                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
    230             END DO 
    231          END DO 
    232          DO jj=1,jpj 
    233             IF (umask(nlci-2,jj,1).NE.0.) THEN 
    234                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*r1_hu_n(nlci-2,jj) 
    235             ENDIF 
    236          END DO 
    237          DO jk=1,jpkm1 
    238             DO jj=j1,j2 
    239                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk) 
    240             END DO 
    241          END DO 
    242  
    243 #if defined key_dynspg_ts 
    244          ! Set tangential velocities to time splitting estimate 
    245          spgv1(nlci-1,:)=0._wp 
    246          DO jk=1,jpkm1 
    247             DO jj=1,jpj 
    248                spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+e3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 
    249             END DO 
    250          END DO 
    251  
    252          DO jj=1,jpj 
    253             spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*r1_hv_a(nlci-1,jj) 
    254          END DO 
    255  
    256          DO jk=1,jpkm1 
    257             DO jj=1,jpj 
    258                va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-spgv1(nlci-1,jj))*vmask(nlci-1,jj,jk) 
    259             END DO 
    260          END DO 
    261 #endif 
    262  
    263       ENDIF 
    264  
    265       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    266  
    267 #if defined key_dynspg_flt 
     221               zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
     222            END DO 
     223            DO jk = 1, jpkm1 
     224               DO jj = 1, jpj 
     225                  va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
     226               END DO 
     227            END DO 
     228         ENDIF 
     229         ! 
     230         ! Mask domain edges: 
     231         !------------------- 
     232         DO jk = 1, jpkm1 
     233            DO jj = 1, jpj 
     234               ua(nlci-1,jj,jk) = 0._wp 
     235               va(nlci  ,jj,jk) = 0._wp 
     236            END DO 
     237         END DO  
     238         ! 
     239      ENDIF 
     240 
     241      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
     242 
     243         ! Smoothing 
     244         ! --------- 
     245         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     246            va_b(:,2) = 0._wp 
     247            DO jk = 1, jpkm1 
     248               DO ji = 1, jpi 
     249                  va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 
     250               END DO 
     251            END DO 
     252            DO ji=1,jpi 
     253               va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)             
     254            END DO 
     255         ENDIF 
     256         ! 
     257         DO jk = 1, jpkm1              ! Smooth 
     258            DO ji = i1, i2 
     259               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
     260                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
     261            END DO 
     262         END DO 
     263         ! 
     264         zvb(:,2) = 0._wp              ! Correct transport 
    268265         DO jk=1,jpkm1 
    269266            DO ji=1,jpi 
    270                va(ji,2,jk) = (va(ji,2,jk) - z2dt * znugdt * laplacv(ji,2))*vmask(ji,2,jk) 
    271             END DO 
    272          END DO 
    273  
    274          spgv(:,2)=0. 
    275  
    276          DO jk=1,jpkm1 
    277             DO ji=1,jpi 
    278                spgv(ji,2)=spgv(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk) 
    279             END DO 
    280          END DO 
    281  
    282          DO ji=1,jpi 
    283             IF (vmask(ji,2,1).NE.0.) THEN 
    284                spgv(ji,2)=spgv(ji,2)* r1_hv_n(ji,2) 
    285             ENDIF 
    286          END DO 
    287 #else 
    288          spgv(:,2)=va_b(:,2) 
    289 #endif 
    290  
    291          DO jk=1,jpkm1 
    292             DO ji=i1,i2 
    293                va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 
    294                va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 
    295             END DO 
    296          END DO 
    297  
    298          spgv1(:,2)=0. 
    299  
    300          DO jk=1,jpkm1 
    301             DO ji=1,jpi 
    302                spgv1(ji,2)=spgv1(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
    303             END DO 
    304          END DO 
    305  
    306          DO ji=1,jpi 
    307             IF (vmask(ji,2,1).NE.0.) THEN 
    308                spgv1(ji,2)=spgv1(ji,2)*r1_hv_n(ji,2) 
    309             ENDIF 
    310          END DO 
    311  
    312          DO jk=1,jpkm1 
    313             DO ji=1,jpi 
    314                va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk) 
    315             END DO 
    316          END DO 
    317  
    318 #if defined key_dynspg_ts 
     267               zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
     268            END DO 
     269         END DO 
     270         DO ji = 1, jpi 
     271            zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
     272         END DO 
     273         DO jk = 1, jpkm1 
     274            DO ji = 1, jpi 
     275               va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
     276            END DO 
     277         END DO 
     278 
    319279         ! Set tangential velocities to time splitting estimate 
    320          spgu1(:,2)=0._wp 
    321          DO jk=1,jpkm1 
    322             DO ji=1,jpi 
    323                spgu1(ji,2)=spgu1(ji,2)+e3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 
    324             END DO 
    325          END DO 
    326  
    327          DO ji=1,jpi 
    328             spgu1(ji,2)=spgu1(ji,2)*r1_hu_a(ji,2) 
    329          END DO 
    330  
    331          DO jk=1,jpkm1 
    332             DO ji=1,jpi 
    333                ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-spgu1(ji,2))*umask(ji,2,jk) 
    334             END DO 
    335          END DO 
    336 #endif 
    337       ENDIF 
    338  
    339       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    340  
    341 #if defined key_dynspg_flt 
    342          DO jk=1,jpkm1 
    343             DO ji=1,jpi 
    344                va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)-z2dt * znugdt * laplacv(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 
    345             END DO 
    346          END DO 
    347  
    348  
    349          spgv(:,nlcj-2)=0. 
    350  
    351          DO jk=1,jpkm1 
    352             DO ji=1,jpi 
    353                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    354             END DO 
    355          END DO 
    356  
    357          DO ji=1,jpi 
    358             IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    359                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 
    360             ENDIF 
    361          END DO 
    362  
    363 #else 
    364          spgv(:,nlcj-2)=va_b(:,nlcj-2) 
    365 #endif 
    366  
    367          DO jk=1,jpkm1 
    368             DO ji=i1,i2 
    369                va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 
    370                va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    371             END DO 
    372          END DO 
    373  
    374          spgv1(:,nlcj-2)=0. 
    375  
    376          DO jk=1,jpkm1 
    377             DO ji=1,jpi 
    378                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    379             END DO 
    380          END DO 
    381  
    382          DO ji=1,jpi 
    383             IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    384                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 
    385             ENDIF 
    386          END DO 
    387  
    388          DO jk=1,jpkm1 
    389             DO ji=1,jpi 
    390                va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 
    391             END DO 
    392          END DO 
    393  
    394 #if defined key_dynspg_ts 
     280         !----------------------------------------------------- 
     281         IF( ln_dynspg_ts ) THEN 
     282            zub(:,2) = 0._wp 
     283            DO jk = 1, jpkm1 
     284               DO ji = 1, jpi 
     285                  zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
     286               END DO 
     287            END DO 
     288            DO ji = 1, jpi 
     289               zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
     290            END DO 
     291 
     292            DO jk = 1, jpkm1 
     293               DO ji = 1, jpi 
     294                  ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
     295               END DO 
     296            END DO 
     297         ENDIF 
     298 
     299         ! Mask domain edges: 
     300         !------------------- 
     301         DO jk = 1, jpkm1 
     302            DO ji = 1, jpi 
     303               ua(ji,1,jk) = 0._wp 
     304               va(ji,1,jk) = 0._wp 
     305            END DO 
     306         END DO  
     307 
     308      ENDIF 
     309 
     310      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
     311         ! 
     312         ! Smoothing 
     313         ! --------- 
     314         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     315            va_b(:,nlcj-2) = 0._wp 
     316            DO jk = 1, jpkm1 
     317               DO ji = 1, jpi 
     318                  va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 
     319               END DO 
     320            END DO 
     321            DO ji = 1, jpi 
     322               va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)             
     323            END DO 
     324         ENDIF 
     325         ! 
     326         DO jk = 1, jpkm1              ! Smooth 
     327            DO ji = i1, i2 
     328               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
     329                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
     330            END DO 
     331         END DO 
     332         ! 
     333         zvb(:,nlcj-2) = 0._wp         ! Correct transport 
     334         DO jk = 1, jpkm1 
     335            DO ji = 1, jpi 
     336               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
     337            END DO 
     338         END DO 
     339         DO ji = 1, jpi 
     340            zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
     341         END DO 
     342         DO jk = 1, jpkm1 
     343            DO ji = 1, jpi 
     344               va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
     345            END DO 
     346         END DO 
     347         ! 
    395348         ! Set tangential velocities to time splitting estimate 
    396          spgu1(:,nlcj-1)=0._wp 
    397          DO jk=1,jpkm1 
    398             DO ji=1,jpi 
    399                spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+e3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 
    400             END DO 
    401          END DO 
    402  
    403          DO ji=1,jpi 
    404             spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*r1_hu_a(ji,nlcj-1) 
    405          END DO 
    406  
    407          DO jk=1,jpkm1 
    408             DO ji=1,jpi 
    409                ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-spgu1(ji,nlcj-1))*umask(ji,nlcj-1,jk) 
    410             END DO 
    411          END DO 
    412 #endif 
    413  
    414       ENDIF 
    415       ! 
    416       CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 
     349         !----------------------------------------------------- 
     350         IF( ln_dynspg_ts ) THEN 
     351            zub(:,nlcj-1) = 0._wp 
     352            DO jk = 1, jpkm1 
     353               DO ji = 1, jpi 
     354                  zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
     355               END DO 
     356            END DO 
     357            DO ji = 1, jpi 
     358               zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
     359            END DO 
     360            ! 
     361            DO jk = 1, jpkm1 
     362               DO ji = 1, jpi 
     363                  ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
     364               END DO 
     365            END DO 
     366         ENDIF 
     367         ! 
     368         ! Mask domain edges: 
     369         !------------------- 
     370         DO jk = 1, jpkm1 
     371            DO ji = 1, jpi 
     372               ua(ji,nlcj  ,jk) = 0._wp 
     373               va(ji,nlcj-1,jk) = 0._wp 
     374            END DO 
     375         END DO  
     376         ! 
     377      ENDIF 
     378      ! 
     379      CALL wrk_dealloc( jpi,jpj,   zub, zvb ) 
    417380      ! 
    418381   END SUBROUTINE Agrif_dyn 
     382 
    419383 
    420384   SUBROUTINE Agrif_dyn_ts( jn ) 
     
    427391      INTEGER :: ji, jj 
    428392      !!----------------------------------------------------------------------   
    429  
     393      ! 
    430394      IF( Agrif_Root() )   RETURN 
    431  
     395      ! 
    432396      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    433397         DO jj=1,jpj 
     
    440404         END DO 
    441405      ENDIF 
    442  
     406      ! 
    443407      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    444408         DO jj=1,jpj 
     
    451415         END DO 
    452416      ENDIF 
    453  
     417      ! 
    454418      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    455419         DO ji=1,jpi 
     
    462426         END DO 
    463427      ENDIF 
    464  
     428      ! 
    465429      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    466430         DO ji=1,jpi 
     
    476440   END SUBROUTINE Agrif_dyn_ts 
    477441 
     442 
    478443   SUBROUTINE Agrif_dta_ts( kt ) 
    479444      !!---------------------------------------------------------------------- 
     
    487452      REAL(wp) :: zrhot, zt 
    488453      !!----------------------------------------------------------------------   
    489  
     454      ! 
    490455      IF( Agrif_Root() )   RETURN 
    491  
    492       ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 
    493       ! the forward case only 
    494  
     456      ! 
     457      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only 
     458      ! 
    495459      zrhot = Agrif_rhot() 
    496  
     460      ! 
    497461      ! "Central" time index for interpolation: 
    498       IF (ln_bt_fw) THEN 
    499          zt = REAL(Agrif_NbStepint()+0.5_wp,wp) / zrhot 
     462      IF( ln_bt_fw ) THEN 
     463         zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot 
    500464      ELSE 
    501          zt = REAL(Agrif_NbStepint(),wp) / zrhot 
    502       ENDIF 
    503  
     465         zt = REAL( Agrif_NbStepint()       , wp ) / zrhot 
     466      ENDIF 
     467      ! 
    504468      ! Linear interpolation of sea level 
    505       Agrif_SpecialValue    = 0.e0 
     469      Agrif_SpecialValue    = 0._wp 
    506470      Agrif_UseSpecialValue = .TRUE. 
    507       CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn ) 
     471      CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn ) 
    508472      Agrif_UseSpecialValue = .FALSE. 
    509  
     473      ! 
    510474      ! Interpolate barotropic fluxes 
    511475      Agrif_SpecialValue=0. 
    512476      Agrif_UseSpecialValue = ln_spc_dyn 
    513  
    514       IF (ll_int_cons) THEN ! Conservative interpolation 
     477      ! 
     478      IF( ll_int_cons ) THEN ! Conservative interpolation 
    515479         ! orders matters here !!!!!! 
    516          CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated 
    517          CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b) 
     480         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
     481         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
    518482         bdy_tinterp = 1 
    519          CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After 
    520          CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb) 
     483         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After 
     484         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  ) 
    521485         bdy_tinterp = 2 
    522          CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before 
    523          CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)          
     486         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before 
     487         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )          
    524488      ELSE ! Linear interpolation 
    525489         bdy_tinterp = 0 
    526          ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0  
    527          ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0  
    528          ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0  
    529          ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0  
    530          CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb) 
    531          CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb) 
     490         ubdy_w(:) = 0._wp   ;   vbdy_w(:) = 0._wp  
     491         ubdy_e(:) = 0._wp   ;   vbdy_e(:) = 0._wp  
     492         ubdy_n(:) = 0._wp   ;   vbdy_n(:) = 0._wp  
     493         ubdy_s(:) = 0._wp   ;   vbdy_s(:) = 0._wp 
     494         CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb ) 
     495         CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb ) 
    532496      ENDIF 
    533497      Agrif_UseSpecialValue = .FALSE. 
     
    535499   END SUBROUTINE Agrif_dta_ts 
    536500 
     501 
    537502   SUBROUTINE Agrif_ssh( kt ) 
    538503      !!---------------------------------------------------------------------- 
     
    542507      !! 
    543508      !!----------------------------------------------------------------------   
    544  
     509      ! 
    545510      IF( Agrif_Root() )   RETURN 
    546  
     511      ! 
    547512      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    548513         ssha(2,:)=ssha(3,:) 
    549514         sshn(2,:)=sshn(3,:) 
    550515      ENDIF 
    551  
     516      ! 
    552517      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    553518         ssha(nlci-1,:)=ssha(nlci-2,:) 
    554519         sshn(nlci-1,:)=sshn(nlci-2,:) 
    555520      ENDIF 
    556  
     521      ! 
    557522      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    558523         ssha(:,2)=ssha(:,3) 
    559524         sshn(:,2)=sshn(:,3) 
    560525      ENDIF 
    561  
     526      ! 
    562527      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    563528         ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    564529         sshn(:,nlcj-1)=sshn(:,nlcj-2) 
    565530      ENDIF 
    566  
     531      ! 
    567532   END SUBROUTINE Agrif_ssh 
     533 
    568534 
    569535   SUBROUTINE Agrif_ssh_ts( jn ) 
     
    575541      INTEGER :: ji,jj 
    576542      !!----------------------------------------------------------------------   
    577  
     543      ! 
    578544      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    579          DO jj=1,jpj 
     545         DO jj = 1, jpj 
    580546            ssha_e(2,jj) = hbdy_w(jj) 
    581547         END DO 
    582548      ENDIF 
    583  
     549      ! 
    584550      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    585          DO jj=1,jpj 
     551         DO jj = 1, jpj 
    586552            ssha_e(nlci-1,jj) = hbdy_e(jj) 
    587553         END DO 
    588554      ENDIF 
    589  
     555      ! 
    590556      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    591          DO ji=1,jpi 
     557         DO ji = 1, jpi 
    592558            ssha_e(ji,2) = hbdy_s(ji) 
    593559         END DO 
    594560      ENDIF 
    595  
     561      ! 
    596562      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    597          DO ji=1,jpi 
     563         DO ji = 1, jpi 
    598564            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
    599565         END DO 
    600566      ENDIF 
    601  
     567      ! 
    602568   END SUBROUTINE Agrif_ssh_ts 
    603569 
    604570# if defined key_zdftke 
     571 
    605572   SUBROUTINE Agrif_tke 
    606573      !!---------------------------------------------------------------------- 
     
    608575      !!----------------------------------------------------------------------   
    609576      REAL(wp) ::   zalpha 
     577      !!----------------------------------------------------------------------   
    610578      ! 
    611579      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 
    612580      IF( zalpha > 1. )   zalpha = 1. 
    613        
     581      ! 
    614582      Agrif_SpecialValue    = 0.e0 
    615583      Agrif_UseSpecialValue = .TRUE. 
    616        
     584      ! 
    617585      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
    618                
     586      ! 
    619587      Agrif_UseSpecialValue = .FALSE. 
    620588      ! 
    621589   END SUBROUTINE Agrif_tke 
     590    
    622591# endif 
    623592 
    624    SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
    625       !!--------------------------------------------- 
     593   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
     594      !!---------------------------------------------------------------------- 
    626595      !!   *** ROUTINE interptsn *** 
    627       !!--------------------------------------------- 
    628       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
    629       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    630       LOGICAL, INTENT(in) :: before 
    631       INTEGER, INTENT(in) :: nb , ndir 
     596      !!---------------------------------------------------------------------- 
     597      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
     598      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     599      LOGICAL                                     , INTENT(in   ) ::  before 
     600      INTEGER                                     , INTENT(in   ) ::  nb , ndir 
    632601      ! 
    633602      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    634       INTEGER :: imin, imax, jmin, jmax 
     603      INTEGER  ::  imin, imax, jmin, jmax 
    635604      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    636605      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    637       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    638  
     606      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     607      !!---------------------------------------------------------------------- 
     608      ! 
    639609      IF (before) THEN          
    640610         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     
    669639         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
    670640         ! 
    671          IF( eastern_side) THEN 
     641         IF( eastern_side ) THEN 
    672642            DO jn = 1, jpts 
    673643               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
    674644               DO jk = 1, jpkm1 
    675645                  DO jj = jmin,jmax 
    676                      IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     646                     IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
    677647                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    678648                     ELSE 
    679649                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    680                         IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     650                        IF( un(nlci-2,jj,jk) > 0._wp ) THEN 
    681651                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) &  
    682652                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     
    685655                  END DO 
    686656               END DO 
    687             ENDDO 
     657               tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 
     658            END DO 
    688659         ENDIF 
    689660         !  
     
    693664               DO jk = 1, jpkm1 
    694665                  DO ji = imin,imax 
    695                      IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     666                     IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
    696667                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    697668                     ELSE 
    698669                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    699                         IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     670                        IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 
    700671                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  & 
    701672                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     
    704675                  END DO 
    705676               END DO 
    706             ENDDO 
    707          ENDIF 
    708          ! 
    709          IF( western_side) THEN             
     677               tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 
     678            END DO 
     679         ENDIF 
     680         ! 
     681         IF( western_side ) THEN             
    710682            DO jn = 1, jpts 
    711683               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
    712684               DO jk = 1, jpkm1 
    713685                  DO jj = jmin,jmax 
    714                      IF( umask(2,jj,jk) == 0.e0 ) THEN 
     686                     IF( umask(2,jj,jk) == 0._wp ) THEN 
    715687                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
    716688                     ELSE 
    717689                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
    718                         IF( un(2,jj,jk) < 0.e0 ) THEN 
     690                        IF( un(2,jj,jk) < 0._wp ) THEN 
    719691                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
    720692                        ENDIF 
     
    722694                  END DO 
    723695               END DO 
     696               tsa(1,j1:j2,k1:k2,jn) = 0._wp 
    724697            END DO 
    725698         ENDIF 
     
    728701            DO jn = 1, jpts 
    729702               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
    730                DO jk=1,jpk       
     703               DO jk = 1, jpk       
    731704                  DO ji=imin,imax 
    732                      IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     705                     IF( vmask(ji,2,jk) == 0._wp ) THEN 
    733706                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
    734707                     ELSE 
    735708                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
    736                         IF( vn(ji,2,jk) < 0.e0 ) THEN 
     709                        IF( vn(ji,2,jk) < 0._wp ) THEN 
    737710                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
    738711                        ENDIF 
     
    740713                  END DO 
    741714               END DO 
    742             ENDDO 
     715               tsa(i1:i2,1,k1:k2,jn) = 0._wp 
     716            END DO 
    743717         ENDIF 
    744718         ! 
     
    766740   END SUBROUTINE interptsn 
    767741 
    768    SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir) 
     742 
     743   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    769744      !!---------------------------------------------------------------------- 
    770745      !!                  ***  ROUTINE interpsshn  *** 
    771746      !!----------------------------------------------------------------------   
    772       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    773       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    774       LOGICAL, INTENT(in) :: before 
    775       INTEGER, INTENT(in) :: nb , ndir 
     747      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     748      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     749      LOGICAL                         , INTENT(in   ) ::   before 
     750      INTEGER                         , INTENT(in   ) ::   nb , ndir 
     751      ! 
    776752      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    777753      !!----------------------------------------------------------------------   
     
    792768   END SUBROUTINE interpsshn 
    793769 
    794    SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before) 
    795       !!--------------------------------------------- 
     770 
     771   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 
     772      !!---------------------------------------------------------------------- 
    796773      !!   *** ROUTINE interpun *** 
    797       !!---------------------------------------------     
    798       !! 
    799       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    800       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    801       LOGICAL, INTENT(in) :: before 
    802       !! 
    803       INTEGER :: ji,jj,jk 
    804       REAL(wp) :: zrhoy  
    805       !!---------------------------------------------     
    806       ! 
    807       IF (before) THEN  
    808          DO jk=1,jpk 
    809             DO jj=j1,j2 
    810                DO ji=i1,i2 
    811                   ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    812                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk) 
    813                END DO 
    814             END DO 
     774      !!---------------------------------------------------------------------- 
     775      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     776      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     777      LOGICAL                               , INTENT(in   ) ::   before 
     778      ! 
     779      INTEGER  ::   ji, jj, jk 
     780      REAL(wp) ::   zrhoy   
     781      !!---------------------------------------------------------------------- 
     782      ! 
     783      IF( before ) THEN  
     784         DO jk = k1, jpk 
     785            ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
    815786         END DO 
    816787      ELSE 
    817788         zrhoy = Agrif_Rhoy() 
    818          DO jk=1,jpkm1 
     789         DO jk = 1, jpkm1 
    819790            DO jj=j1,j2 
    820                ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 
    821                ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / e3u_n(i1:i2,jj,jk) 
     791               ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) ) 
    822792            END DO 
    823793         END DO 
     
    827797 
    828798 
    829    SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before) 
    830       !!--------------------------------------------- 
    831       !!   *** ROUTINE interpun *** 
    832       !!---------------------------------------------     
    833       ! 
    834       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    835       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    836       LOGICAL, INTENT(in) :: before 
    837       ! 
    838       INTEGER :: ji,jj 
    839       REAL(wp) :: ztref 
    840       REAL(wp) :: zrhoy  
    841       !!---------------------------------------------     
    842       ! 
    843       ztref = 1. 
    844  
    845       IF (before) THEN  
    846          DO jj=j1,j2 
    847             DO ji=i1,MIN(i2,nlci-1) 
    848                ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj))  
    849             END DO 
    850          END DO 
    851       ELSE 
    852          zrhoy = Agrif_Rhoy() 
    853          DO jj=j1,j2 
    854             laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1) 
    855          END DO 
    856       ENDIF 
    857       !  
    858    END SUBROUTINE interpun2d 
    859  
    860  
    861    SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 
    862       !!--------------------------------------------- 
     799   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 
     800      !!---------------------------------------------------------------------- 
    863801      !!   *** ROUTINE interpvn *** 
    864       !!---------------------------------------------     
    865       ! 
    866       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    867       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    868       LOGICAL, INTENT(in) :: before 
    869       ! 
    870       INTEGER :: ji,jj,jk 
    871       REAL(wp) :: zrhox  
    872       !!---------------------------------------------     
     802      !!---------------------------------------------------------------------- 
     803      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     804      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     805      LOGICAL                               , INTENT(in   ) ::   before 
     806      ! 
     807      INTEGER  ::   ji, jj, jk 
     808      REAL(wp) ::   zrhox   
     809      !!---------------------------------------------------------------------- 
    873810      !       
    874       IF (before) THEN           
    875          !interpv entre 1 et k2 et interpv2d en jpkp1 
    876          DO jk=k1,jpk 
    877             DO jj=j1,j2 
    878                DO ji=i1,i2 
    879                   ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    880                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 
    881                END DO 
    882             END DO 
     811      IF( before ) THEN       !interpv entre 1 et k2 et interpv2d en jpkp1 
     812         DO jk = k1, jpk 
     813            ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk) 
    883814         END DO 
    884815      ELSE           
    885816         zrhox= Agrif_Rhox() 
    886          DO jk=1,jpkm1 
    887             DO jj=j1,j2 
    888                va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 
    889                va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / e3v_n(i1:i2,jj,jk) 
    890             END DO 
     817         DO jk = 1, jpkm1 
     818            va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) ) 
    891819         END DO 
    892820      ENDIF 
    893821      !         
    894822   END SUBROUTINE interpvn 
    895  
    896    SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before) 
    897       !!--------------------------------------------- 
    898       !!   *** ROUTINE interpvn *** 
    899       !!---------------------------------------------     
    900       ! 
    901       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    902       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    903       LOGICAL, INTENT(in) :: before 
    904       ! 
    905       INTEGER :: ji,jj 
    906       REAL(wp) :: zrhox  
    907       REAL(wp) :: ztref 
    908       !!---------------------------------------------     
    909       !  
    910       ztref = 1.     
    911       IF (before) THEN  
    912          !interpv entre 1 et k2 et interpv2d en jpkp1 
    913          DO jj=j1,MIN(j2,nlcj-1) 
    914             DO ji=i1,i2 
    915                ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1) 
    916             END DO 
    917          END DO 
    918       ELSE            
    919          zrhox = Agrif_Rhox() 
    920          DO ji=i1,i2 
    921             laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2))) 
    922          END DO 
    923       ENDIF 
    924       !       
    925    END SUBROUTINE interpvn2d 
    926  
    927    SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     823    
     824 
     825   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    928826      !!---------------------------------------------------------------------- 
    929827      !!                  ***  ROUTINE interpunb  *** 
    930828      !!----------------------------------------------------------------------   
    931       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    932       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    933       LOGICAL, INTENT(in) :: before 
    934       INTEGER, INTENT(in) :: nb , ndir 
    935       !! 
    936       INTEGER :: ji,jj 
    937       REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 
    938       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    939       !!----------------------------------------------------------------------   
    940       ! 
    941       IF (before) THEN  
    942          DO jj=j1,j2 
    943             DO ji=i1,i2 
    944                ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu_n(ji,jj)  
    945             END DO 
    946          END DO 
     829      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     830      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     831      LOGICAL                         , INTENT(in   ) ::   before 
     832      INTEGER                         , INTENT(in   ) ::   nb , ndir 
     833      ! 
     834      INTEGER  ::   ji, jj 
     835      REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff 
     836      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     837      !!----------------------------------------------------------------------   
     838      ! 
     839      IF( before ) THEN  
     840         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2) 
    947841      ELSE 
    948842         western_side  = (nb == 1).AND.(ndir == 1) 
     
    958852         IF( bdy_tinterp == 1 ) THEN 
    959853            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    960                   &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     854               &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    961855         ELSEIF( bdy_tinterp == 2 ) THEN 
    962856            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    963                   &      - zt0        * (       zt0 - 1._wp)**2._wp )  
     857               &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    964858 
    965859         ELSE 
     
    982876         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    983877            IF(western_side) THEN 
    984                ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
    985                      &                                  * umask(i1,j1:j2,1) 
     878               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    986879            ENDIF 
    987880            IF(eastern_side) THEN 
    988                ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
    989                      &                                  * umask(i1,j1:j2,1) 
     881               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    990882            ENDIF 
    991883            IF(southern_side) THEN 
    992                ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
    993                      &                                  * umask(i1:i2,j1,1) 
     884               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    994885            ENDIF 
    995886            IF(northern_side) THEN 
    996                ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
    997                      &                                  * umask(i1:i2,j1,1) 
     887               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    998888            ENDIF 
    999889         ENDIF 
     
    1002892   END SUBROUTINE interpunb 
    1003893 
    1004    SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     894 
     895   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    1005896      !!---------------------------------------------------------------------- 
    1006897      !!                  ***  ROUTINE interpvnb  *** 
    1007898      !!----------------------------------------------------------------------   
    1008       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    1009       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    1010       LOGICAL, INTENT(in) :: before 
    1011       INTEGER, INTENT(in) :: nb , ndir 
    1012       !! 
    1013       INTEGER :: ji,jj 
    1014       REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff    
    1015       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     899      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     900      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     901      LOGICAL                         , INTENT(in   ) ::  before 
     902      INTEGER                         , INTENT(in   ) ::  nb , ndir 
     903      ! 
     904      INTEGER  ::  ji,jj 
     905      REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff    
     906      LOGICAL  ::  western_side, eastern_side,northern_side,southern_side 
    1016907      !!----------------------------------------------------------------------   
    1017908      !  
    1018       IF (before) THEN  
    1019          DO jj=j1,j2 
    1020             DO ji=i1,i2 
    1021                ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv_n(ji,jj)  
    1022             END DO 
    1023          END DO 
     909      IF( before ) THEN  
     910         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2) 
    1024911      ELSE 
    1025912         western_side  = (nb == 1).AND.(ndir == 1) 
     
    1034921         IF( bdy_tinterp == 1 ) THEN 
    1035922            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1036                   &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     923               &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1037924         ELSEIF( bdy_tinterp == 2 ) THEN 
    1038925            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1039                   &      - zt0        * (       zt0 - 1._wp)**2._wp )  
    1040  
     926               &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    1041927         ELSE 
    1042928            ztcoeff = 1 
     
    1078964   END SUBROUTINE interpvnb 
    1079965 
    1080    SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     966 
     967   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    1081968      !!---------------------------------------------------------------------- 
    1082969      !!                  ***  ROUTINE interpub2b  *** 
    1083970      !!----------------------------------------------------------------------   
    1084       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    1085       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    1086       LOGICAL, INTENT(in) :: before 
    1087       INTEGER, INTENT(in) :: nb , ndir 
    1088       !! 
    1089       INTEGER :: ji,jj 
    1090       REAL(wp) :: zrhot, zt0, zt1,zat 
    1091       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     971      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     972      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     973      LOGICAL                         , INTENT(in   ) ::  before 
     974      INTEGER                         , INTENT(in   ) ::  nb , ndir 
     975      ! 
     976      INTEGER  ::  ji,jj 
     977      REAL(wp) ::   zrhot, zt0, zt1,zat 
     978      LOGICAL  ::  western_side, eastern_side,northern_side,southern_side 
    1092979      !!----------------------------------------------------------------------   
    1093980      IF( before ) THEN 
    1094          DO jj=j1,j2 
    1095             DO ji=i1,i2 
    1096                ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 
    1097             END DO 
    1098          END DO 
     981         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 
    1099982      ELSE 
    1100983         western_side  = (nb == 1).AND.(ndir == 1) 
     
    1107990         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    1108991         ! Polynomial interpolation coefficients: 
    1109          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
    1110                &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
     992         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
     993            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    1111994         !  
    1112995         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     
    11171000      !  
    11181001   END SUBROUTINE interpub2b 
    1119  
    1120    SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     1002    
     1003 
     1004   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    11211005      !!---------------------------------------------------------------------- 
    11221006      !!                  ***  ROUTINE interpvb2b  *** 
    11231007      !!----------------------------------------------------------------------   
    1124       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    1125       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    1126       LOGICAL, INTENT(in) :: before 
    1127       INTEGER, INTENT(in) :: nb , ndir 
    1128       !! 
    1129       INTEGER :: ji,jj 
    1130       REAL(wp) :: zrhot, zt0, zt1,zat 
    1131       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1008      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1009      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1010      LOGICAL                         , INTENT(in   ) ::  before 
     1011      INTEGER                         , INTENT(in   ) ::  nb , ndir 
     1012      ! 
     1013      INTEGER ::   ji,jj 
     1014      REAL(wp) ::   zrhot, zt0, zt1,zat 
     1015      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    11321016      !!----------------------------------------------------------------------   
    11331017      ! 
    11341018      IF( before ) THEN 
    1135          DO jj=j1,j2 
    1136             DO ji=i1,i2 
    1137                ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 
    1138             END DO 
    1139          END DO 
     1019         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
    11401020      ELSE       
    11411021         western_side  = (nb == 1).AND.(ndir == 1) 
     
    11481028         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    11491029         ! Polynomial interpolation coefficients: 
    1150          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
    1151                &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
    1152          ! 
    1153          IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    1154          IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
    1155          IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
    1156          IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1030         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
     1031            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
     1032         ! 
     1033         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1034         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1035         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1036         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    11571037      ENDIF 
    11581038      !       
    11591039   END SUBROUTINE interpvb2b 
    11601040 
    1161    SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1041 
     1042   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    11621043      !!---------------------------------------------------------------------- 
    11631044      !!                  ***  ROUTINE interpe3t  *** 
    11641045      !!----------------------------------------------------------------------   
    1165       !  
    1166       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     1046      INTEGER                              , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    11671047      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1168       LOGICAL :: before 
    1169       INTEGER, INTENT(in) :: nb , ndir 
     1048      LOGICAL                              , INTENT(in   ) :: before 
     1049      INTEGER                              , INTENT(in   ) :: nb , ndir 
    11701050      ! 
    11711051      INTEGER :: ji, jj, jk 
     
    11741054      !!----------------------------------------------------------------------   
    11751055      !     
    1176       IF (before) THEN 
    1177          DO jk=k1,k2 
    1178             DO jj=j1,j2 
    1179                DO ji=i1,i2 
    1180                   ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    1181                END DO 
    1182             END DO 
    1183          END DO 
     1056      IF( before ) THEN 
     1057         ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 
    11841058      ELSE 
    11851059         western_side  = (nb == 1).AND.(ndir == 1) 
     
    11881062         northern_side = (nb == 2).AND.(ndir == 2) 
    11891063 
    1190          DO jk=k1,k2 
    1191             DO jj=j1,j2 
    1192                DO ji=i1,i2 
     1064         DO jk = k1, k2 
     1065            DO jj = j1, j2 
     1066               DO ji = i1, i2 
    11931067                  ! Get velocity mask at boundary edge points: 
    1194                   IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1) 
    1195                   IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1) 
    1196                   IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1) 
    1197                   IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1) 
    1198  
    1199                   IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN 
     1068                  IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1) 
     1069                  IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1) 
     1070                  IF( northern_side)  ztmpmsk = vmask(ji    ,nlcj-2,1) 
     1071                  IF( southern_side)  ztmpmsk = vmask(ji    ,2     ,1) 
     1072                  ! 
     1073                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 
    12001074                     IF (western_side) THEN 
    12011075                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     
    12131087            END DO 
    12141088         END DO 
    1215  
     1089         ! 
    12161090      ENDIF 
    12171091      !  
     
    12191093 
    12201094 
    1221    SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1095   SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    12221096      !!---------------------------------------------------------------------- 
    12231097      !!                  ***  ROUTINE interpumsk  *** 
    12241098      !!----------------------------------------------------------------------   
    1225       !  
    1226       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1227       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1228       LOGICAL :: before 
    1229       INTEGER, INTENT(in) :: nb , ndir 
    1230       ! 
    1231       INTEGER :: ji, jj, jk 
    1232       LOGICAL :: western_side, eastern_side    
     1099      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     1100      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1101      LOGICAL ,                            , INTENT(in   ) ::   before 
     1102      INTEGER                              , INTENT(in   ) ::   nb , ndir 
     1103      ! 
     1104      INTEGER ::   ji, jj, jk 
     1105      LOGICAL ::   western_side, eastern_side    
    12331106      !!----------------------------------------------------------------------   
    12341107      !     
    1235       IF (before) THEN 
    1236          DO jk=k1,k2 
    1237             DO jj=j1,j2 
    1238                DO ji=i1,i2 
    1239                   ptab(ji,jj,jk) = umask(ji,jj,jk) 
    1240                END DO 
    1241             END DO 
    1242          END DO 
     1108      IF( before ) THEN 
     1109         ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2) 
    12431110      ELSE 
    1244  
    1245          western_side  = (nb == 1).AND.(ndir == 1) 
    1246          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1247          DO jk=k1,k2 
    1248             DO jj=j1,j2 
    1249                DO ji=i1,i2 
     1111         western_side = (nb == 1).AND.(ndir == 1) 
     1112         eastern_side = (nb == 1).AND.(ndir == 2) 
     1113         DO jk = k1, k2 
     1114            DO jj = j1, j2 
     1115               DO ji = i1, i2 
    12501116                   ! Velocity mask at boundary edge points: 
    12511117                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 
     
    12631129            END DO 
    12641130         END DO 
    1265  
     1131         ! 
    12661132      ENDIF 
    12671133      !  
    12681134   END SUBROUTINE interpumsk 
    12691135 
    1270    SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1136 
     1137   SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    12711138      !!---------------------------------------------------------------------- 
    12721139      !!                  ***  ROUTINE interpvmsk  *** 
    12731140      !!----------------------------------------------------------------------   
    1274       !  
    1275       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1276       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1277       LOGICAL :: before 
    1278       INTEGER, INTENT(in) :: nb , ndir 
    1279       ! 
    1280       INTEGER :: ji, jj, jk 
    1281       LOGICAL :: northern_side, southern_side      
     1141      INTEGER                              , INTENT(in   ) ::   i1,i2,j1,j2,k1,k2 
     1142      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1143      LOGICAL                              , INTENT(in   ) ::   before 
     1144      INTEGER                              , INTENT(in   ) :: nb , ndir 
     1145      ! 
     1146      INTEGER ::   ji, jj, jk 
     1147      LOGICAL ::   northern_side, southern_side      
    12821148      !!----------------------------------------------------------------------   
    12831149      !     
    1284       IF (before) THEN 
    1285          DO jk=k1,k2 
    1286             DO jj=j1,j2 
    1287                DO ji=i1,i2 
    1288                   ptab(ji,jj,jk) = vmask(ji,jj,jk) 
    1289                END DO 
    1290             END DO 
    1291          END DO 
     1150      IF( before ) THEN 
     1151         ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2) 
    12921152      ELSE 
    1293  
    12941153         southern_side = (nb == 2).AND.(ndir == 1) 
    12951154         northern_side = (nb == 2).AND.(ndir == 2) 
    1296          DO jk=k1,k2 
    1297             DO jj=j1,j2 
    1298                DO ji=i1,i2 
     1155         DO jk = k1, k2 
     1156            DO jj = j1, j2 
     1157               DO ji = i1, i2 
    12991158                   ! Velocity mask at boundary edge points: 
    13001159                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 
     
    13121171            END DO 
    13131172         END DO 
    1314  
     1173         ! 
    13151174      ENDIF 
    13161175      !  
     
    13191178# if defined key_zdftke 
    13201179 
    1321    SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) 
     1180   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 
    13221181      !!---------------------------------------------------------------------- 
    13231182      !!                  ***  ROUTINE interavm  *** 
    13241183      !!----------------------------------------------------------------------   
    1325       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1326       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1327       LOGICAL, INTENT(in) :: before 
     1184      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     1185      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1186      LOGICAL                              , INTENT(in   ) ::  before 
    13281187      !!----------------------------------------------------------------------   
    13291188      !       
    1330       IF( before) THEN 
     1189      IF( before ) THEN 
    13311190         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    13321191      ELSE 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r5845 r6004  
    22 
    33MODULE agrif_opa_sponge 
     4   !!====================================================================== 
     5   !!                ***  MODULE agrif_opa_update  *** 
     6   !! AGRIF :    
     7   !!====================================================================== 
     8   !! History :   
     9   !!---------------------------------------------------------------------- 
    410#if defined key_agrif  && ! defined key_offline 
    511   USE par_oce 
     
    1824 
    1925   !!---------------------------------------------------------------------- 
    20    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     26   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    2127   !! $Id$ 
    2228   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2329   !!---------------------------------------------------------------------- 
    24  
    2530CONTAINS 
    2631 
     
    2934      !!   *** ROUTINE Agrif_Sponge_Tra *** 
    3035      !!--------------------------------------------- 
    31       !! 
    3236      REAL(wp) :: timecoeff 
    33  
     37      !!--------------------------------------------- 
     38      ! 
    3439#if defined SPONGE 
    3540      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     
    4449      Agrif_UseSpecialValue = .FALSE. 
    4550#endif 
    46  
     51      ! 
    4752   END SUBROUTINE Agrif_Sponge_Tra 
    4853 
     54 
    4955   SUBROUTINE Agrif_Sponge_dyn 
    5056      !!--------------------------------------------- 
    5157      !!   *** ROUTINE Agrif_Sponge_dyn *** 
    5258      !!--------------------------------------------- 
    53       !! 
    5459      REAL(wp) :: timecoeff 
     60      !!--------------------------------------------- 
    5561 
    5662#if defined SPONGE 
     
    7076      Agrif_UseSpecialValue = .FALSE. 
    7177#endif 
    72  
     78      ! 
    7379   END SUBROUTINE Agrif_Sponge_dyn 
     80 
    7481 
    7582   SUBROUTINE Agrif_Sponge 
     
    181188      ! 
    182189#endif 
    183  
     190      ! 
    184191   END SUBROUTINE Agrif_Sponge 
     192 
    185193 
    186194   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
     
    191199      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    192200      LOGICAL, INTENT(in) :: before 
    193  
    194  
     201      ! 
    195202      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    196203      INTEGER  ::   iku, ikv 
     
    199206      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
    200207      ! 
    201       IF (before) THEN 
     208      IF( before ) THEN 
    202209         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
    203210      ELSE    
    204     
     211         ! 
    205212         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)     
    206213         DO jn = 1, jpts             
     
    212219                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    213220                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    214                   ENDDO 
    215                ENDDO 
    216  
     221                  END DO 
     222               END DO 
     223               ! 
    217224               IF( ln_zps ) THEN      ! set gradient at partial step level 
    218225                  DO jj = j1,j2-1 
     
    221228                        iku = mbku(ji,jj) 
    222229                        ikv = mbkv(ji,jj) 
    223                         IF( iku == jk ) THEN 
    224                            ztu(ji,jj,jk) = 0._wp 
    225                         ENDIF 
    226                         IF( ikv == jk ) THEN 
    227                            ztv(ji,jj,jk) = 0._wp 
    228                         ENDIF 
     230                        IF( iku == jk )   ztu(ji,jj,jk) = 0._wp 
     231                        IF( ikv == jk )   ztv(ji,jj,jk) = 0._wp 
    229232                     END DO 
    230233                  END DO 
    231234               ENDIF 
    232             ENDDO 
    233  
     235            END DO 
     236            ! 
    234237            DO jk = 1, jpkm1 
    235238               DO jj = j1+1,j2-1 
    236239                  DO ji = i1+1,i2-1 
    237  
    238240                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
    239241                        zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     
    243245                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
    244246                     ENDIF 
    245  
    246                   ENDDO 
    247                ENDDO 
    248  
    249             ENDDO 
    250          ENDDO 
    251  
     247                  END DO 
     248               END DO 
     249            END DO 
     250            ! 
     251         END DO 
     252         ! 
    252253         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
    253  
    254       ENDIF 
    255  
     254         ! 
     255      ENDIF 
     256      ! 
    256257   END SUBROUTINE interptsn_sponge 
     258 
    257259 
    258260   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 
     
    271273      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    272274      INTEGER :: jmax 
    273       ! 
    274  
    275  
    276       IF (before) THEN 
     275      !!---------------------------------------------     
     276      ! 
     277      IF( before ) THEN 
    277278         tabres = un(i1:i2,j1:j2,:) 
    278279      ELSE 
    279  
    280280         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 
    281  
     281         ! 
    282282         DO jk = 1, jpkm1                                 ! Horizontal slab 
    283283            !                                             ! =============== 
     
    302302               END DO 
    303303            END DO 
    304          ENDDO 
    305  
    306          ! 
    307  
    308  
    309  
     304         END DO 
     305         ! 
    310306         DO jj = j1+1, j2-1 
    311307            DO ji = i1+1, i2-1   ! vector opt. 
     
    349345                  END DO 
    350346               ENDIF 
    351  
    352             END DO 
    353          END DO 
    354  
    355  
     347               ! 
     348            END DO 
     349         END DO 
     350         ! 
    356351         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 
    357  
    358       ENDIF 
    359  
    360  
     352         ! 
     353      ENDIF 
     354      ! 
    361355   END SUBROUTINE interpun_sponge 
    362356 
     
    370364      LOGICAL, INTENT(in) :: before 
    371365      INTEGER, INTENT(in) :: nb , ndir 
    372  
    373       INTEGER :: ji,jj,jk 
    374  
    375       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    376  
     366      ! 
     367      INTEGER  ::   ji, jj, jk 
     368      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr 
    377369      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 
    378370      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    379371      INTEGER :: imax 
    380       ! 
    381  
    382       IF (before) THEN  
     372      !!---------------------------------------------  
     373 
     374      IF( before ) THEN  
    383375         tabres = vn(i1:i2,j1:j2,:) 
    384376      ELSE 
    385  
     377         ! 
    386378         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 
    387  
     379         ! 
    388380         DO jk = 1, jpkm1                                 ! Horizontal slab 
    389381            !                                             ! =============== 
     
    403395                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    404396                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    405                                     &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) & 
    406                                     & ) * fmask(ji,jj,jk) * zbtr 
    407                END DO 
    408             END DO 
    409          ENDDO 
     397                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk)  ) * fmask(ji,jj,jk) * zbtr 
     398               END DO 
     399            END DO 
     400         END DO 
    410401 
    411402         !                                                ! =============== 
     
    413404 
    414405         imax = i2-1 
    415          IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 
     406         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3) 
    416407 
    417408         DO jj = j1+1, j2 
    418409            DO ji = i1+1, imax   ! vector opt. 
    419                IF (.NOT. tabspongedone_u(ji,jj)) THEN 
    420                   DO jk = 1, jpkm1                                 ! Horizontal slab 
    421                      ze2u = rotdiff (ji,jj,jk) 
    422                      ze1v = hdivdiff(ji,jj,jk) 
    423                      ! horizontal diffusive trends 
    424                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
    425                            / e1u(ji,jj) 
    426  
    427  
    428                      ! add it to the general momentum trends 
    429                      ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    430                   END DO 
    431  
    432                ENDIF 
    433             END DO 
    434          END DO 
    435  
     410               IF( .NOT. tabspongedone_u(ji,jj) ) THEN 
     411                  DO jk = 1, jpkm1 
     412                     ua(ji,jj,jk) = ua(ji,jj,jk)                                                               & 
     413                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )  & 
     414                        & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj) 
     415                  END DO 
     416               ENDIF 
     417            END DO 
     418         END DO 
     419         ! 
    436420         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 
    437  
     421         ! 
    438422         DO jj = j1+1, j2-1 
    439423            DO ji = i1+1, i2-1   ! vector opt. 
    440                IF (.NOT. tabspongedone_v(ji,jj)) THEN 
    441                   DO jk = 1, jpkm1                                 ! Horizontal slab 
    442                      ze2u = rotdiff (ji,jj,jk) 
    443                      ze1v = hdivdiff(ji,jj,jk) 
    444                      ! horizontal diffusive trends 
    445  
    446                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
    447                            / e2v(ji,jj) 
    448  
    449                      ! add it to the general momentum trends 
    450                      va(ji,jj,jk) = va(ji,jj,jk) + zva 
     424               IF( .NOT. tabspongedone_v(ji,jj) ) THEN 
     425                  DO jk = 1, jpkm1 
     426                     va(ji,jj,jk) = va(ji,jj,jk)                                                                  & 
     427                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
     428                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj) 
    451429                  END DO 
    452430               ENDIF 
     
    455433         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
    456434      ENDIF 
    457  
     435      ! 
    458436   END SUBROUTINE interpvn_sponge 
    459437 
    460438#else 
    461439CONTAINS 
    462  
    463440   SUBROUTINE agrif_opa_sponge_empty 
    464441      !!--------------------------------------------- 
     
    469446#endif 
    470447 
     448   !!====================================================================== 
    471449END MODULE agrif_opa_sponge 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r5845 r6004  
    1111   USE lib_mpp 
    1212   USE wrk_nemo   
    13    USE dynspg_oce 
    1413   USE zdf_oce        ! vertical physics: ocean variables  
    1514 
     
    107106# endif 
    108107 
    109 # if defined key_dynspg_ts 
    110       IF (ln_bt_fw) THEN 
     108      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
    111109         ! Update time integrated transports 
    112110         IF (mod(nbcline,nbclineupdate) == 0) THEN 
     
    128126         ENDIF 
    129127      END IF 
    130 # endif 
    131128      ! 
    132129      nbcline = nbcline + 1 
     
    237234      !!           *** ROUTINE updateu *** 
    238235      !!--------------------------------------------- 
    239       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     236      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    240237      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    241       LOGICAL, INTENT(in) :: before 
    242       !!  
    243       INTEGER :: ji, jj, jk 
    244       REAL(wp) :: zrhoy 
    245       !!--------------------------------------------- 
    246       !  
    247       IF (before) THEN 
     238      LOGICAL                               , INTENT(in   ) :: before 
     239      ! 
     240      INTEGER  ::  ji, jj, jk 
     241      REAL(wp) ::   zrhoy 
     242      !!--------------------------------------------- 
     243      !  
     244      IF( before ) THEN 
    248245         zrhoy = Agrif_Rhoy() 
     246         DO jk = k1, k2 
     247            tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
     248         END DO 
     249      ELSE 
    249250         DO jk=k1,k2 
    250251            DO jj=j1,j2 
    251252               DO ji=i1,i2 
    252                   tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    253                END DO 
    254             END DO 
    255          END DO 
    256          tabres = zrhoy * tabres 
    257       ELSE 
    258          DO jk=k1,k2 
    259             DO jj=j1,j2 
    260                DO ji=i1,i2 
    261                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     253                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 
    262254                  ! 
    263255                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     
    292284            DO jj=j1,j2 
    293285               DO ji=i1,i2 
    294                   tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    295                END DO 
    296             END DO 
    297          END DO 
    298          tabres = zrhox * tabres 
     286                  tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     287               END DO 
     288            END DO 
     289         END DO 
    299290      ELSE 
    300291         DO jk=k1,k2 
    301292            DO jj=j1,j2 
    302293               DO ji=i1,i2 
    303                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
     294                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk) 
    304295                  ! 
    305296                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     
    334325         DO jj=j1,j2 
    335326            DO ji=i1,i2 
    336                tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
    337             END DO 
    338          END DO 
    339          tabres = zrhoy * tabres 
     327               tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
     328            END DO 
     329         END DO 
    340330      ELSE 
    341331         DO jj=j1,j2 
     
    344334               !     
    345335               ! Update "now" 3d velocities: 
    346                spgu(ji,jj) = 0.e0 
     336               spgu(ji,jj) = 0._wp 
    347337               DO jk=1,jpkm1 
    348338                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 
     
    356346               ! 
    357347               ! Update barotropic velocities: 
    358 #if defined key_dynspg_ts 
    359                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    360                   zcorr = tabres(ji,jj) - un_b(ji,jj) 
    361                   ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
    362                END IF 
    363 #endif                
     348               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
     349                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     350                     zcorr = tabres(ji,jj) - un_b(ji,jj) 
     351                     ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
     352                  END IF 
     353               ENDIF              
    364354               un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 
    365355               !        
     
    400390         DO jj=j1,j2 
    401391            DO ji=i1,i2 
    402                tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
    403             END DO 
    404          END DO 
    405          tabres = zrhox * tabres 
     392               tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
     393            END DO 
     394         END DO 
    406395      ELSE 
    407396         DO jj=j1,j2 
     
    422411               ! 
    423412               ! Update barotropic velocities: 
    424 #if defined key_dynspg_ts 
    425                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    426                   zcorr = tabres(ji,jj) - vn_b(ji,jj) 
    427                   vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
    428                END IF 
    429 #endif                
     413               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
     414                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     415                     zcorr = tabres(ji,jj) - vn_b(ji,jj) 
     416                     vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
     417                  END IF 
     418               ENDIF               
    430419               vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 
    431420               !        
     
    467456         END DO 
    468457      ELSE 
    469 #if ! defined key_dynspg_ts 
    470          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    471             DO jj=j1,j2 
    472                DO ji=i1,i2 
    473                   sshb(ji,jj) =   sshb(ji,jj) & 
    474                         & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
    475                END DO 
    476             END DO 
     458         IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 
     459            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     460               DO jj=j1,j2 
     461                  DO ji=i1,i2 
     462                     sshb(ji,jj) =   sshb(ji,jj) & 
     463                           & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     464                  END DO 
     465               END DO 
     466            ENDIF 
    477467         ENDIF 
    478 #endif 
     468         ! 
    479469         DO jj=j1,j2 
    480470            DO ji=i1,i2 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r5845 r6004  
    44   USE oce 
    55   USE dom_oce       
    6    USE sol_oce 
    76   USE agrif_oce 
    87   USE agrif_top_sponge 
     
    2322   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2423   !!---------------------------------------------------------------------- 
    25  
    26    CONTAINS 
     24CONTAINS 
    2725 
    2826   SUBROUTINE Agrif_trc 
     
    4038      ! 
    4139   END SUBROUTINE Agrif_trc 
     40 
    4241 
    4342   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r5845 r6004  
    22 
    33MODULE agrif_top_sponge 
     4   !!====================================================================== 
     5   !!                ***  MODULE agrif_top_sponge  *** 
     6   !! AGRIF :   define in memory AGRIF variables for sea-ice 
     7   !!====================================================================== 
     8   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code 
     9   !!---------------------------------------------------------------------- 
     10 
     11   !!---------------------------------------------------------------------- 
     12   !!   Agrif_Sponge_trc :  
     13   !!   interptrn_sponge :   
     14   !!---------------------------------------------------------------------- 
    415#if defined key_agrif && defined key_top 
    516   USE par_oce 
    617   USE par_trc 
    718   USE oce 
     19   USE trc 
    820   USE dom_oce 
    9    USE in_out_manager 
    1021   USE agrif_oce 
    1122   USE agrif_opa_sponge 
    12    USE trc 
     23   ! 
     24   USE in_out_manager 
    1325   USE lib_mpp 
    1426   USE wrk_nemo   
     
    2032 
    2133   !!---------------------------------------------------------------------- 
    22    !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     34   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    2335   !! $Id$ 
    2436   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2537   !!---------------------------------------------------------------------- 
    26  
    2738CONTAINS 
    2839 
    2940   SUBROUTINE Agrif_Sponge_trc 
    30       !!--------------------------------------------- 
    31       !!   *** ROUTINE Agrif_Sponge_Trc *** 
    32       !!--------------------------------------------- 
    33       !!  
    34       REAL(wp) :: timecoeff 
    35  
     41      !!---------------------------------------------------------------------- 
     42      !!                   *** ROUTINE Agrif_Sponge_Trc *** 
     43      !!---------------------------------------------------------------------- 
     44      REAL(wp) ::   timecoeff 
     45      !!---------------------------------------------------------------------- 
     46      ! 
    3647#if defined SPONGE_TOP 
    37       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     48      timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 
    3849      CALL Agrif_sponge 
    39       Agrif_SpecialValue=0. 
     50      Agrif_SpecialValue    = 0._wp 
    4051      Agrif_UseSpecialValue = .TRUE. 
    41       tabspongedone_trn = .FALSE. 
    42       CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge) 
     52      tabspongedone_trn     = .FALSE. 
     53      CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge ) 
    4354      Agrif_UseSpecialValue = .FALSE. 
    44  
    4555#endif 
    46  
     56      ! 
    4757   END SUBROUTINE Agrif_Sponge_Trc 
    4858 
    49    SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
    50       !!--------------------------------------------- 
    51       !!   *** ROUTINE interptrn_sponge *** 
    52       !!--------------------------------------------- 
    53       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    54       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    55       LOGICAL, INTENT(in) :: before 
    5659 
    57  
     60   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     61      !!---------------------------------------------------------------------- 
     62      !!                   *** ROUTINE interptrn_sponge *** 
     63      !!---------------------------------------------------------------------- 
     64      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     65      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     66      LOGICAL                                     , INTENT(in   ) ::   before 
     67      ! 
    5868      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    59  
    60       REAL(wp) :: ztra, zabe1, zabe2, zbtr 
    61       REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 
    62       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff 
     69      REAL(wp) ::   zabe1, zabe2 
     70      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv 
     71      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff 
     72      !!---------------------------------------------------------------------- 
    6373      ! 
    64       IF (before) THEN 
     74      IF( before ) THEN 
    6575         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    6676      ELSE       
    67  
     77!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected 
    6878         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)       
    6979         DO jn = 1, jptra 
    7080            DO jk = 1, jpkm1 
    71  
    7281               DO jj = j1,j2-1 
    7382                  DO ji = i1,i2-1 
    74                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
    75                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
     83                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     84                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    7685                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    7786                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    78                   ENDDO 
    79                ENDDO 
    80  
     87                  END DO 
     88               END DO 
     89               ! 
    8190               DO jj = j1+1,j2-1 
    8291                  DO ji = i1+1,i2-1 
    83  
    84                      IF (.NOT. tabspongedone_trn(ji,jj)) THEN  
    85                         zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk) 
    86                         ! horizontal diffusive trends 
    87                         ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
    88                         ! add it to the general tracer trends 
    89                         tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     92                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN  
     93                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     & 
     94                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  & 
     95                           &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    9096                     ENDIF 
    91  
    92                   ENDDO 
    93                ENDDO 
    94  
    95             ENDDO 
    96          ENDDO 
    97  
     97                  END DO 
     98               END DO 
     99            END DO 
     100            ! 
     101         END DO 
     102         ! 
    98103         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
    99104      ENDIF 
     
    102107 
    103108#else 
     109 
    104110CONTAINS 
    105  
    106111   SUBROUTINE agrif_top_sponge_empty 
    107       !!--------------------------------------------- 
    108       !!   *** ROUTINE agrif_top_sponge_empty *** 
    109       !!--------------------------------------------- 
    110112      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?' 
    111113   END SUBROUTINE agrif_top_sponge_empty 
    112114#endif 
    113115 
     116   !!====================================================================== 
    114117END MODULE agrif_top_sponge 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r5845 r6004  
    33 
    44MODULE agrif_top_update 
     5   !!====================================================================== 
     6   !!                ***  MODULE agrif_top_update  *** 
     7   !! AGRIF :    
     8   !!---------------------------------------------------------------------- 
     9   !! History :   
     10   !!---------------------------------------------------------------------- 
    511 
    612#if defined key_agrif && defined key_top 
    713   USE par_oce 
    814   USE oce 
     15   USE par_trc 
     16   USE trc 
    917   USE dom_oce 
    1018   USE agrif_oce 
    11    USE par_trc 
    12    USE trc 
    1319   USE wrk_nemo   
    1420 
     
    1824   PUBLIC Agrif_Update_Trc 
    1925 
    20    INTEGER, PUBLIC :: nbcline_trc = 0 
     26   INTEGER, PUBLIC ::   nbcline_trc = 0   !: ??? 
    2127 
    2228   !!---------------------------------------------------------------------- 
    23    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     29   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    2430   !! $Id$ 
    2531   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2632   !!---------------------------------------------------------------------- 
    27  
    2833CONTAINS 
    2934 
    3035   SUBROUTINE Agrif_Update_Trc( kt ) 
    31       !!--------------------------------------------- 
    32       !!   *** ROUTINE Agrif_Update_Trc *** 
    33       !!--------------------------------------------- 
    34       INTEGER, INTENT(in) :: kt 
    35       !!--------------------------------------------- 
     36      !!---------------------------------------------------------------------- 
     37      !!                   *** ROUTINE Agrif_Update_Trc *** 
     38      !!---------------------------------------------------------------------- 
     39      INTEGER, INTENT(in) ::   kt 
     40      !!---------------------------------------------------------------------- 
    3641      !  
    3742      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    3843#if defined TWO_WAY    
    3944      Agrif_UseSpecialValueInUpdate = .TRUE. 
    40       Agrif_SpecialValueFineGrid = 0. 
     45      Agrif_SpecialValueFineGrid    = 0._wp 
    4146      !  
    42       IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 
     47      IF( MOD(nbcline_trc,nbclineupdate) == 0 ) THEN 
    4348# if ! defined DECAL_FEEDBACK 
    44          CALL Agrif_Update_Variable(trn_id, procname=updateTRC) 
     49         CALL Agrif_Update_Variable(trn_id, procname=updateTRC ) 
    4550# else 
    46          CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC) 
     51         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC ) 
    4752# endif 
    4853      ELSE 
    4954# if ! defined DECAL_FEEDBACK 
    50          CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC) 
     55         CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC ) 
    5156# else 
    52          CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC) 
     57         CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC ) 
    5358# endif 
    5459      ENDIF 
     
    6065   END SUBROUTINE Agrif_Update_Trc 
    6166 
     67 
    6268   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    63       !!--------------------------------------------- 
    64       !!           *** ROUTINE updateT *** 
    65       !!--------------------------------------------- 
    66       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    67       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
    68       LOGICAL, INTENT(in) :: before 
     69      !!---------------------------------------------------------------------- 
     70      !!                      *** ROUTINE updateT *** 
     71      !!---------------------------------------------------------------------- 
     72      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     73      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
     74      LOGICAL                                    , INTENT(in   ) ::  before 
    6975      !! 
    70       INTEGER :: ji,jj,jk,jn 
    71       !!--------------------------------------------- 
     76      INTEGER ::   ji, jj, jk, jn 
     77      !!---------------------------------------------------------------------- 
    7278      ! 
    73       IF (before) THEN 
    74          DO jn = n1,n2 
    75             DO jk=k1,k2 
    76                DO jj=j1,j2 
    77                   DO ji=i1,i2 
    78                      ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     79      IF( before ) THEN 
     80         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     81      ELSE 
     82         IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN 
     83            ! Add asselin part 
     84            DO jn = n1,n2 
     85               DO jk = k1, k2 
     86                  DO jj = j1, j2 
     87                     DO ji = i1, i2 
     88                        IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 
     89                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn)             &  
     90                              &             + atfp * ( ptab(ji,jj,jk,jn)   & 
     91                                 &                    - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     92                        ENDIF 
     93                     END DO 
    7994                  END DO 
    8095               END DO 
    8196            END DO 
    82          END DO 
    83       ELSE 
    84          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    85             ! Add asselin part 
    86             DO jn = n1,n2 
    87                DO jk=k1,k2 
    88                   DO jj=j1,j2 
    89                      DO ji=i1,i2 
    90                         IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 
    91                            trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) &  
    92                                  & + atfp * ( ptab(ji,jj,jk,jn) & 
    93                                  &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    94                         ENDIF 
    95                      ENDDO 
    96                   ENDDO 
    97                ENDDO 
    98             ENDDO 
    9997         ENDIF 
    100          DO jn = n1,n2 
    101             DO jk=k1,k2 
    102                DO jj=j1,j2 
    103                   DO ji=i1,i2 
    104                      IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN  
     98         DO jn = n1, n2 
     99            DO jk = k1, k2 
     100               DO jj = j1, j2 
     101                  DO ji = i1, i2 
     102                     IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN  
    105103                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    106104                     END IF 
     
    122120   END SUBROUTINE agrif_top_update_empty 
    123121#endif 
     122 
     123   !!====================================================================== 
    124124END MODULE agrif_top_update 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r5656 r6004  
    11#if defined key_agrif 
    22!!---------------------------------------------------------------------- 
    3 !! NEMO/NST 3.4 , NEMO Consortium (2012) 
     3!! NEMO/NST 3.7 , NEMO Consortium (2015) 
    44!! $Id$ 
    55!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    104104   USE dom_oce 
    105105   USE nemogcm 
    106    USE sol_oce 
    107106   USE in_out_manager 
    108107   USE agrif_opa_update 
     
    172171   USE dom_oce 
    173172   USE nemogcm 
    174    USE sol_oce 
    175173   USE lib_mpp 
    176174   USE in_out_manager 
     
    210208   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
    211209 
    212 #if defined key_dynspg_ts 
    213210   Agrif_UseSpecialValue = .TRUE. 
    214211   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
    215212 
    216    Agrif_UseSpecialValue = ln_spc_dyn 
    217    CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    218    CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    219    CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    220    CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    221    ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
    222    ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
    223    ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
    224    ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
    225 #endif 
     213   IF ( ln_dynspg_ts ) THEN 
     214      Agrif_UseSpecialValue = ln_spc_dyn 
     215      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
     216      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     217      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
     218      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     219      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
     220      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
     221      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
     222      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
     223   ENDIF 
    226224 
    227225   Agrif_UseSpecialValue = .FALSE.  
     
    278276         ENDIF 
    279277      ENDIF 
     278 
     279      ! Check free surface scheme 
     280      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     281         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
     282         WRITE(*,*) 'incompatible free surface scheme between grids' 
     283         WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts ) 
     284         WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 
     285         WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts 
     286         WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp 
     287         WRITE(*,*) 'those logicals should be identical'                   
     288         STOP 
     289      ENDIF 
     290 
    280291      ! check if masks and bathymetries match 
    281292      IF(ln_chk_bathy) THEN 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r5845 r6004  
    458458      END DO 
    459459      !                              !  update the horizontal divergence with the runoff inflow 
    460       IF( ln_dynrnf )  zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 
     460      IF( ln_dynrnf )   zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 
    461461      ! 
    462462      CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r5836 r6004  
    3333   USE eosbn2             ! Equation of state (eos_bn2 routine) 
    3434   USE zdfmxl             ! Mixed layer depth 
    35    USE dom_oce, ONLY :   ndastp 
    36    USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory 
     35   USE dom_oce     , ONLY :   ndastp 
    3736   USE in_out_manager     ! I/O manager 
    3837   USE iom                ! I/O module 
     
    4544   USE ice 
    4645#endif 
     46 
    4747   IMPLICIT NONE 
    4848   PRIVATE 
     
    114114            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
    115115#endif 
    116             CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
    117116            ! 
    118117            CALL iom_close( inum ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r5845 r6004  
    2929   USE iom             ! IOM library 
    3030   USE in_out_manager  ! I/O logical units 
    31    USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag 
    3231#if defined key_lim2 
    3332   USE ice_2 
     
    4645   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set. 
    4746   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets. 
    48  
    4947   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions 
    5048                                                               ! =F => baroclinic velocities in 3D boundary conditions 
     
    7573      !!                 
    7674      !!---------------------------------------------------------------------- 
    77       !! 
    78       INTEGER, INTENT( in )           ::   kt    ! ocean time-step index  
    79       INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
    80       INTEGER, INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
    81                                                         ! is present then units = subcycle timesteps. 
    82                                                         ! time_offset = 0 => get data at "now" time level 
    83                                                         ! time_offset = -1 => get data at "before" time level 
    84                                                         ! time_offset = +1 => get data at "after" time level 
    85                                                         ! etc. 
    86       !! 
    87       INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices 
     75      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index  
     76      INTEGER, INTENT(in), OPTIONAL ::   jit          ! subcycle time-step index (for timesplitting option) 
     77      INTEGER, INTENT(in), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
     78      !                                               ! is present then units = subcycle timesteps. 
     79      !                                               ! time_offset = 0 => get data at "now" time level 
     80      !                                               ! time_offset = -1 => get data at "before" time level 
     81      !                                               ! time_offset = +1 => get data at "after" time level 
     82      !                                               ! etc. 
     83      ! 
     84      INTEGER ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices 
    8885      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    8986      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
    9087      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut 
    91       !! 
    9288      !!--------------------------------------------------------------------------- 
    93       !! 
    94       IF( nn_timing == 1 ) CALL timing_start('bdy_dta') 
    95  
     89      ! 
     90      IF( nn_timing == 1 )   CALL timing_start('bdy_dta') 
     91      ! 
    9692      ! Initialise data arrays once for all from initial conditions where required 
    9793      !--------------------------------------------------------------------------- 
    98       IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN 
     94      IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN 
    9995 
    10096         ! Calculate depth-mean currents 
     
    10298          
    10399         DO ib_bdy = 1, nb_bdy 
    104  
     100            ! 
    105101            nblen => idx_bdy(ib_bdy)%nblen 
    106102            nblenrim => idx_bdy(ib_bdy)%nblenrim 
    107103            dta => dta_bdy(ib_bdy) 
    108104 
    109             IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
     105            IF( nn_dyn2d_dta(ib_bdy) == 0 ) THEN  
    110106               ilen1(:) = nblen(:) 
    111107               IF( dta%ll_ssh ) THEN  
     
    135131            ENDIF 
    136132 
    137             IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
     133            IF( nn_dyn3d_dta(ib_bdy) == 0 ) THEN  
    138134               ilen1(:) = nblen(:) 
    139135               IF( dta%ll_u3d ) THEN  
     
    159155            ENDIF 
    160156 
    161             IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
     157            IF( nn_tra_dta(ib_bdy) == 0 ) THEN  
    162158               ilen1(:) = nblen(:) 
    163159               IF( dta%ll_tem ) THEN 
     
    184180 
    185181#if defined key_lim2 
    186             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN  
     182            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    187183               ilen1(:) = nblen(:) 
    188184               IF( dta%ll_frld ) THEN 
     
    212208            ENDIF 
    213209#elif defined key_lim3 
    214             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN  
     210            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    215211               ilen1(:) = nblen(:) 
    216212               IF( dta%ll_a_i ) THEN 
     
    246242            ENDIF 
    247243#endif 
    248  
    249          ENDDO ! ib_bdy 
    250  
    251  
    252       ENDIF ! kt .eq. nit000 
     244         END DO ! ib_bdy 
     245         ! 
     246      ENDIF ! kt == nit000 
    253247 
    254248      ! update external data from files 
     
    258252      DO ib_bdy = 1, nb_bdy    
    259253         dta => dta_bdy(ib_bdy) 
    260          IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 
     254         IF( nn_dta(ib_bdy) == 1 ) THEN ! skip this bit if no external data required 
    261255       
    262256            IF( PRESENT(jit) ) THEN 
     
    264258               ! jit is optional argument for fld_read and bdytide_update 
    265259               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    266                   IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    267                      IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
    268                      IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
    269                      IF( dta%ll_u3d ) dta%v2d(:) = 0.0 
     260                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     261                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 
     262                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 
     263                     IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 
    270264                  ENDIF 
    271265                  IF (cn_tra(ib_bdy) /= 'runoff') THEN 
    272                      IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 
     266                     IF( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 
    273267 
    274268                        jend = jstart + dta%nread(2) - 1 
     
    278272                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    279273                        IF( ln_full_vel_array(ib_bdy) .AND.                                             & 
    280                           &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    281                           &      nn_dyn3d_dta(ib_bdy) .EQ. 1 ) )THEN 
     274                          &    ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR.  & 
     275                          &      nn_dyn3d_dta(ib_bdy) == 1 ) )THEN 
    282276 
    283277                           igrd = 2                      ! zonal velocity 
    284                            dta%u2d(:) = 0.0 
     278                           dta%u2d(:) = 0._wp 
    285279                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    286280                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    293287                           END DO 
    294288                           igrd = 3                      ! meridional velocity 
    295                            dta%v2d(:) = 0.0 
     289                           dta%v2d(:) = 0._wp 
    296290                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    297291                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    331325                  END DO 
    332326               ELSE 
    333                   IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    334                      IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
    335                      IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
    336                      IF( dta%ll_v2d ) dta%v2d(:) = 0.0 
     327                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     328                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 
     329                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 
     330                     IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 
    337331                  ENDIF 
    338332                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data 
     
    343337                  ! If full velocities in boundary data then split into barotropic and baroclinic data 
    344338                  IF( ln_full_vel_array(ib_bdy) .and.                                             & 
    345                     & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. & 
    346                     &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 
     339                    & ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. & 
     340                    &   nn_dyn3d_dta(ib_bdy) == 1 ) ) THEN 
    347341                     igrd = 2                      ! zonal velocity 
    348                      dta%u2d(:) = 0.0 
     342                     dta%u2d(:) = 0._wp 
    349343                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    350344                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    360354                     END DO 
    361355                     igrd = 3                      ! meridional velocity 
    362                      dta%v2d(:) = 0.0 
     356                     dta%v2d(:) = 0._wp 
    363357                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    364358                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    387381      END DO  ! ib_bdy 
    388382 
    389       ! bg jchanut tschanges 
    390383#if defined key_tide 
    391       ! Add tides if not split-explicit free surface else this is done in ts loop 
    392       IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
    393 #endif 
    394       ! end jchanut tschanges 
     384      IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                            
     385         DO ib_bdy = 1, nb_bdy    ! Tidal component added in ts loop 
     386            IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
     387               nblen => idx_bdy(ib_bdy)%nblen 
     388               nblenrim => idx_bdy(ib_bdy)%nblenrim 
     389               IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
     390               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1)) 
     391               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2)) 
     392               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3)) 
     393            ENDIF 
     394         END DO 
     395      ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
     396         ! 
     397         CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
     398      ENDIF 
     399#endif 
    395400 
    396401      IF ( ln_apr_obc ) THEN 
     
    402407                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    403408                  dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij) 
    404                ENDDO 
    405             ENDIF 
    406          ENDDO 
     409               END DO 
     410            ENDIF 
     411         END DO 
    407412      ENDIF 
    408  
     413      ! 
    409414      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta') 
    410  
    411       END SUBROUTINE bdy_dta 
    412  
    413  
    414       SUBROUTINE bdy_dta_init 
     415      ! 
     416   END SUBROUTINE bdy_dta 
     417 
     418 
     419   SUBROUTINE bdy_dta_init 
    415420      !!---------------------------------------------------------------------- 
    416421      !!                   ***  SUBROUTINE bdy_dta_init  *** 
     
    422427      !!                 
    423428      !!---------------------------------------------------------------------- 
    424       USE dynspg_oce, ONLY: lk_dynspg_ts 
    425       !! 
    426       INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices 
    427       INTEGER      ::   ios                               ! Local integer output status for namelist read 
    428       !! 
     429      INTEGER ::   ib_bdy, jfld, jstart, jend, ierror, ios     ! Local integers 
     430      ! 
    429431      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
    430432      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files 
     433      CHARACTER(len = 256)::   clname                           ! temporary file name 
    431434      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data 
    432435                                                                ! =F => baroclinic velocities in 3D boundary data 
     
    458461      NAMELIST/nambdy_dta/ ln_full_vel 
    459462      !!--------------------------------------------------------------------------- 
    460  
    461       IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init') 
    462  
     463      ! 
     464      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_init') 
     465      ! 
    463466      IF(lwp) WRITE(numout,*) 
    464467      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries' 
     
    475478#endif 
    476479                              ) 
    477          IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1 
     480         IF(nn_dta(ib_bdy) > 1) nn_dta(ib_bdy) = 1 
    478481      END DO 
    479482 
     
    483486      nb_bdy_fld(:) = 0 
    484487      DO ib_bdy = 1, nb_bdy          
    485          IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
     488         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) THEN 
    486489            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    487490         ENDIF 
    488          IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
     491         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) == 1 ) THEN 
    489492            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    490493         ENDIF 
    491          IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
     494         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) == 1  ) THEN 
    492495            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    493496         ENDIF 
    494497#if ( defined key_lim2 || defined key_lim3 ) 
    495          IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) .eq. 1  ) THEN 
     498         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN 
    496499            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    497500         ENDIF 
    498501#endif                
    499502         IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy) 
    500       ENDDO             
     503      END DO             
    501504 
    502505      nb_bdy_fld_sum = SUM( nb_bdy_fld ) 
     
    524527      jfld = 0  
    525528      DO ib_bdy = 1, nb_bdy          
    526          IF( nn_dta(ib_bdy) .eq. 1 ) THEN 
     529         IF( nn_dta(ib_bdy) == 1 ) THEN 
    527530            READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    528 901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
     531901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
    529532 
    530533            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
    531 902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
    532             IF(lwm) WRITE ( numond, nambdy_dta ) 
     534902         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
     535            IF(lwm) WRITE( numond, nambdy_dta ) 
    533536 
    534537            cn_dir_array(ib_bdy) = cn_dir 
     
    542545            ! Only read in necessary fields for this set. 
    543546            ! Important that barotropic variables come first. 
    544             IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN  
     547            IF( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN  
    545548 
    546549               IF( dta%ll_ssh ) THEN  
     
    581584            ! read 3D velocities if baroclinic velocities require OR if 
    582585            ! barotropic velocities required and ln_full_vel set to .true. 
    583             IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
    584            &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    585  
    586                IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     586            IF( nn_dyn3d_dta(ib_bdy) == 1 .OR. & 
     587           &  ( ln_full_vel_array(ib_bdy) .AND. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN 
     588 
     589               IF( dta%ll_u3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
    587590                  if(lwp) write(numout,*) '++++++ reading in u3d field' 
    588591                  jfld = jfld + 1 
     
    595598               ENDIF 
    596599 
    597                IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     600               IF( dta%ll_v3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
    598601                  if(lwp) write(numout,*) '++++++ reading in v3d field' 
    599602                  jfld = jfld + 1 
     
    609612 
    610613            ! temperature and salinity 
    611             IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
     614            IF( nn_tra_dta(ib_bdy) == 1 ) THEN 
    612615 
    613616               IF( dta%ll_tem ) THEN 
     
    635638#if defined key_lim2 
    636639            ! sea ice 
    637             IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
     640            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    638641 
    639642               IF( dta%ll_frld ) THEN 
     
    667670#elif defined key_lim3 
    668671            ! sea ice 
    669             IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
    670  
     672            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    671673               ! Test for types of ice input (lim2 or lim3)  
    672                CALL iom_open ( bn_a_i%clname, inum ) 
    673                id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     674               ! Build file name to find dimensions  
     675               clname=TRIM(bn_a_i%clname) 
     676               IF( .NOT. bn_a_i%ln_clim ) THEN    
     677                                                  WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear    ! add year 
     678                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname        ), nmonth   ! add month 
     679               ELSE 
     680                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth   ! add month 
     681               ENDIF 
     682               IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 
     683               &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname        ), nday     ! add day 
     684               ! 
     685               CALL iom_open  ( clname, inum ) 
     686               id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
    674687               CALL iom_close ( inum ) 
    675                !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 
    676                !CALL iom_open ( bn_a_i%clname, inum ) 
    677                !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     688 
    678689                IF ( zndims == 4 ) THEN 
    679690                 ll_bdylim3 = .TRUE.   ! lim3 input 
     
    714725            ! Recalculate field counts 
    715726            !------------------------- 
    716             IF( ib_bdy .eq. 1 ) THEN  
     727            IF( ib_bdy == 1 ) THEN  
    717728               nb_bdy_fld_sum = 0 
    718729               nb_bdy_fld(ib_bdy) = jfld 
     
    725736            dta%nread(1) = nb_bdy_fld(ib_bdy) 
    726737 
    727          ENDIF ! nn_dta .eq. 1 
     738         ENDIF ! nn_dta == 1 
    728739      ENDDO ! ib_bdy 
    729740 
     
    766777         endif 
    767778 
    768          IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 
     779         IF ( nn_dyn2d_dta(ib_bdy) == 0 .or. nn_dyn2d_dta(ib_bdy) == 2 ) THEN 
    769780            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 
    770781            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 
     
    772783            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 
    773784         ENDIF 
    774          IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 
     785         IF ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 
    775786            IF( dta%ll_ssh ) THEN 
    776787               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 
     
    800811         ENDIF 
    801812 
    802          IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
     813         IF ( nn_dyn3d_dta(ib_bdy) == 0 ) THEN 
    803814            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 
    804815            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 
    805816            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 
    806817         ENDIF 
    807          IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
    808            &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     818         IF ( nn_dyn3d_dta(ib_bdy) == 1 .or. & 
     819           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN 
    809820            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
    810821               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 
     
    819830         ENDIF 
    820831 
    821          IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
     832         IF( nn_tra_dta(ib_bdy) == 0 ) THEN 
    822833            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 
    823834            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 
     
    838849#if defined key_lim2 
    839850         IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    840             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
     851            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    841852               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
    842853               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
     
    853864#elif defined key_lim3 
    854865         IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    855             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
     866            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    856867               ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) ) 
    857868               ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 
     
    873884                  ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 
    874885                  ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 
    875                   dta_bdy(ib_bdy)%a_i (:,:) = 0.0 
    876                   dta_bdy(ib_bdy)%ht_i(:,:) = 0.0 
    877                   dta_bdy(ib_bdy)%ht_s(:,:) = 0.0 
     886                  dta_bdy(ib_bdy)%a_i (:,:) = 0._wp 
     887                  dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp 
     888                  dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp 
    878889               ENDIF 
    879890 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r5845 r6004  
    2424   USE oce             ! ocean dynamics and tracers  
    2525   USE dom_oce         ! ocean space and time domain 
    26    USE dynspg_oce       
    2726   USE bdy_oce         ! ocean open boundary conditions 
    2827   USE bdydyn2d        ! open boundary conditions for barotropic solution 
     
    3534   PRIVATE 
    3635 
    37    PUBLIC   bdy_dyn     ! routine called in dynspg_flt (if lk_dynspg_flt) or  
    38                         ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 
     36   PUBLIC   bdy_dyn    ! routine called in dyn_nxt 
    3937 
    4038   !!---------------------------------------------------------------------- 
     
    5250      !! 
    5351      !!---------------------------------------------------------------------- 
    54       INTEGER, INTENT( in )           :: kt               ! Main time step counter 
    55       LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
     52      INTEGER, INTENT(in)           ::   kt           ! Main time step counter 
     53      LOGICAL, INTENT(in), OPTIONAL ::   dyn3d_only   ! T => only update baroclinic velocities 
    5654      ! 
    57       INTEGER :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
    58       LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 
     55      INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter 
     56      LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski 
    5957      REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d     ! after barotropic velocities 
    6058      !!---------------------------------------------------------------------- 
     
    6866         IF( dyn3d_only )   ll_dyn2d = .false. 
    6967      ENDIF 
    70  
     68      ! 
    7169      ll_orlanski = .false. 
    7270      DO ib_bdy = 1, nb_bdy 
    73          IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
    74      &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo')   ll_orlanski = .true. 
     71         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
     72     &   .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo')   ll_orlanski = .true. 
    7573      END DO 
    7674 
     
    135133      CALL wrk_dealloc( jpi,jpj,  pua2d, pva2d )  
    136134      ! 
    137       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 
     135      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn') 
    138136      ! 
    139137   END SUBROUTINE bdy_dyn 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r5215 r6004  
    2323   USE bdy_oce         ! ocean open boundary conditions 
    2424   USE bdylib          ! BDY library routines 
    25    USE dynspg_oce      ! for barotropic variables 
    2625   USE phycst          ! physical constants 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r5845 r6004  
    4343      !! 
    4444      !!---------------------------------------------------------------------- 
    45       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    46       ! 
    47       INTEGER               :: ib_bdy ! loop index 
     45      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
     46      ! 
     47      INTEGER ::   ib_bdy  ! loop index 
    4848      !!---------------------------------------------------------------------- 
    4949      ! 
     
    7272      !! 
    7373      !!---------------------------------------------------------------------- 
    74       INTEGER        , INTENT(in) ::   kt 
     74      INTEGER        , INTENT(in) ::   kt      ! time step index 
    7575      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    7676      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
     
    118118      !! 
    119119      !!---------------------------------------------------------------------- 
    120       INTEGER        , INTENT(in) ::   kt 
    121       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    122       TYPE(OBC_DATA) , INTENT(in) ::   dta  ! OBC external data 
     120      INTEGER        , INTENT(in) ::   kt      ! time step index 
     121      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     122      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    123123      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    124       !! 
     124      ! 
    125125      INTEGER  ::   ib, ik         ! dummy loop indices 
    126       INTEGER  ::   ii, ij, igrd, zcoef   ! local integers 
     126      INTEGER  ::   ii, ij, igrd   ! local integers 
    127127      REAL(wp) ::   zwgt           ! boundary weight 
    128128      !!---------------------------------------------------------------------- 
     
    150150      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
    151151      ! 
    152       IF( kt == nit000 ) CLOSE( unit = 102 ) 
     152      IF( kt == nit000 )   CLOSE( unit = 102 ) 
    153153      ! 
    154154      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_zro') 
     
    168168      !!               topography. Tellus, 365-382. 
    169169      !!---------------------------------------------------------------------- 
    170       INTEGER        , INTENT(in) ::   kt 
    171       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    172       TYPE(OBC_DATA) , INTENT(in) ::   dta  ! OBC external data 
     170      INTEGER        , INTENT(in) ::   kt      ! time step index 
     171      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     172      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    173173      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    174174      ! 
     
    204204      IF( kt == nit000 )   CLOSE( unit = 102 ) 
    205205      ! 
    206       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs') 
     206      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_frs') 
    207207      ! 
    208208   END SUBROUTINE bdy_dyn3d_frs 
     
    254254      !! 
    255255      !!---------------------------------------------------------------------- 
    256       INTEGER, INTENT(in) ::   kt 
     256      INTEGER, INTENT(in) ::   kt   ! time step index 
    257257      ! 
    258258      INTEGER  ::   jb, jk         ! dummy loop indices 
     259      INTEGER  ::   ib_bdy         ! loop index 
    259260      INTEGER  ::   ii, ij, igrd   ! local integers 
    260261      REAL(wp) ::   zwgt           ! boundary weight 
    261       INTEGER  ::   ib_bdy         ! loop index 
    262       !!---------------------------------------------------------------------- 
    263       ! 
    264       IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 
     262      !!---------------------------------------------------------------------- 
     263      ! 
     264      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn3d_dmp') 
    265265      ! 
    266266      DO ib_bdy=1, nb_bdy 
     
    288288            END DO 
    289289         ENDIF 
    290       ENDDO 
     290      END DO 
    291291      ! 
    292292      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 
    293293      ! 
    294       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp') 
     294      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_dmp') 
    295295      ! 
    296296   END SUBROUTINE bdy_dyn3d_dmp 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r5866 r6004  
    1212   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    1313   !!            3.4  !  2012     (J. Chanut) straight open boundary case update 
    14    !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the  
    15    !!                             optimization of BDY communications 
     14   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) optimization of BDY communications 
    1615   !!---------------------------------------------------------------------- 
    1716#if defined key_bdy 
     
    1918   !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    2019   !!---------------------------------------------------------------------- 
    21    !!   bdy_init       : Initialization of unstructured open boundaries 
     20   !!   bdy_init      : Initialization of unstructured open boundaries 
    2221   !!---------------------------------------------------------------------- 
    23    USE wrk_nemo        ! Memory Allocation 
    24    USE timing          ! Timing 
    25    USE oce             ! ocean dynamics and tracers variables 
    26    USE dom_oce         ! ocean space and time domain 
    27    USE bdy_oce         ! unstructured open boundary conditions 
    28    USE in_out_manager  ! I/O units 
    29    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    30    USE lib_mpp         ! for mpp_sum   
    31    USE iom             ! I/O 
    32    USE sbctide, ONLY: lk_tide ! Tidal forcing or not 
    33    USE phycst, ONLY: rday 
     22   USE oce            ! ocean dynamics and tracers variables 
     23   USE dom_oce        ! ocean space and time domain 
     24   USE bdy_oce        ! unstructured open boundary conditions 
     25   USE sbctide  , ONLY: lk_tide ! Tidal forcing or not 
     26   USE phycst   , ONLY: rday 
     27   ! 
     28   USE in_out_manager ! I/O units 
     29   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     30   USE lib_mpp        ! for mpp_sum   
     31   USE iom            ! I/O 
     32   USE wrk_nemo       ! Memory Allocation 
     33   USE timing         ! Timing 
    3434 
    3535   IMPLICIT NONE 
     
    3838   PUBLIC   bdy_init   ! routine called in nemo_init 
    3939 
    40    INTEGER, PARAMETER          :: jp_nseg = 100 
    41    INTEGER, PARAMETER          :: nrimmax = 20 ! maximum rimwidth in structured 
     40   INTEGER, PARAMETER ::   jp_nseg = 100   !  
     41   INTEGER, PARAMETER ::   nrimmax =  20  ! maximum rimwidth in structured 
    4242                                               ! open boundary data files 
    4343   ! Straight open boundary segment parameters: 
    44    INTEGER  :: nbdysege, nbdysegw, nbdysegn, nbdysegs  
    45    INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge 
    46    INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw 
    47    INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn 
    48    INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs 
     44   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs  
     45   INTEGER, DIMENSION(jp_nseg) ::   jpieob, jpjedt, jpjeft, npckge   ! 
     46   INTEGER, DIMENSION(jp_nseg) ::   jpiwob, jpjwdt, jpjwft, npckgw   ! 
     47   INTEGER, DIMENSION(jp_nseg) ::   jpjnob, jpindt, jpinft, npckgn   ! 
     48   INTEGER, DIMENSION(jp_nseg) ::   jpjsob, jpisdt, jpisft, npckgs   ! 
    4949   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     50   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    5151   !! $Id$  
    5252   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6666      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    6767      !!----------------------------------------------------------------------       
    68       ! namelist variables 
    69       !------------------- 
    70       CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile 
    71       CHARACTER(LEN=1)   ::   ctypebdy 
    72       INTEGER :: nbdyind, nbdybeg, nbdyend 
    7368 
    7469      ! local variables 
     
    8176      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
    8277      INTEGER  ::   i_offset, j_offset                     !   -       - 
    83       INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts 
     78      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts 
    8479      REAL(wp), POINTER  ::  flagu, flagv                  !    -   - 
    8580      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
     
    9489      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
    9590      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    96  
     91      !! 
     92      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile     ! Namelist variables 
     93      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        -  
     94      INTEGER                              ::   nbdyind, nbdybeg, nbdyend 
    9795      !! 
    9896      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,                 & 
     
    103101         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
    104102         &             ln_vol, nn_volctl, nn_rimwidth 
    105       !! 
     103         ! 
    106104      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 
    107105      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    108106      !!---------------------------------------------------------------------- 
    109  
    110       IF( nn_timing == 1 ) CALL timing_start('bdy_init') 
    111  
     107      ! 
     108      IF( nn_timing == 1 )   CALL timing_start('bdy_init') 
     109      ! 
    112110      IF(lwp) WRITE(numout,*) 
    113111      IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 
    114112      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    115113      ! 
    116  
    117114      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   & 
    118115         &                               ' and general open boundary condition are not compatible' ) 
    119116 
    120       cgrid= (/'t','u','v'/) 
     117      cgrid = (/'t','u','v'/) 
    121118       
    122119      ! ------------------------ 
    123120      ! Read namelist parameters 
    124121      ! ------------------------ 
    125  
    126122      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries   
    127123      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    128 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    129  
     124901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     125      ! 
    130126      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    131127      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    132 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     128902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    133129      IF(lwm) WRITE ( numond, nambdy ) 
    134130 
     
    137133      ! ----------------------------------------- 
    138134      !                                   ! control prints 
    139       IF(lwp) WRITE(numout,*) '         nambdy' 
    140  
    141       IF( nb_bdy .eq. 0 ) THEN  
     135      IF(lwp) WRITE(numout,*) '   nambdy' 
     136 
     137      IF( nb_bdy == 0 ) THEN  
    142138        IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 
    143139      ELSE 
    144         IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ',nb_bdy 
     140        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy 
    145141      ENDIF 
    146142 
     
    158154        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
    159155        SELECT CASE( cn_dyn2d(ib_bdy) )                   
    160           CASE('none')          
     156          CASE( 'none' )          
    161157             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    162158             dta_bdy(ib_bdy)%ll_ssh = .false. 
    163159             dta_bdy(ib_bdy)%ll_u2d = .false. 
    164160             dta_bdy(ib_bdy)%ll_v2d = .false. 
    165           CASE('frs')           
     161          CASE( 'frs' )           
    166162             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    167163             dta_bdy(ib_bdy)%ll_ssh = .false. 
    168164             dta_bdy(ib_bdy)%ll_u2d = .true. 
    169165             dta_bdy(ib_bdy)%ll_v2d = .true. 
    170           CASE('flather')       
     166          CASE( 'flather' )       
    171167             IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
    172168             dta_bdy(ib_bdy)%ll_ssh = .true. 
    173169             dta_bdy(ib_bdy)%ll_u2d = .true. 
    174170             dta_bdy(ib_bdy)%ll_v2d = .true. 
    175           CASE('orlanski')      
     171          CASE( 'orlanski' )      
    176172             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
    177173             dta_bdy(ib_bdy)%ll_ssh = .false. 
    178174             dta_bdy(ib_bdy)%ll_u2d = .true. 
    179175             dta_bdy(ib_bdy)%ll_v2d = .true. 
    180           CASE('orlanski_npo')  
     176          CASE( 'orlanski_npo' )  
    181177             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
    182178             dta_bdy(ib_bdy)%ll_ssh = .false. 
     
    392388      REWIND( numnam_cfg )      
    393389 
    394       !!---------------------------------------------------------------------- 
    395  
    396                
    397                 
    398390      nblendta(:,:) = 0 
    399391      nbdysege = 0 
     
    492484               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 
    493485               jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) 
    494             ENDDO 
     486            END DO 
    495487            CALL iom_close( inum ) 
    496  
     488            ! 
    497489         ENDIF  
    498  
    499       ENDDO ! ib_bdy 
     490         ! 
     491      END DO ! ib_bdy 
    500492 
    501493      IF (nb_bdy>0) THEN 
     
    514506      ! Now look for crossings in user (namelist) defined open boundary segments: 
    515507      !-------------------------------------------------------------------------- 
    516       IF ( icount>0 ) CALL bdy_ctl_seg 
     508      IF( icount>0 )  CALL bdy_ctl_seg 
    517509 
    518510      ! Calculate global boundary index arrays or read in from file 
     
    520512      ! 1. Read global index arrays from boundary coordinates file. 
    521513      DO ib_bdy = 1, nb_bdy 
    522  
     514         ! 
    523515         IF( ln_coords_file(ib_bdy) ) THEN 
    524  
     516            ! 
    525517            CALL iom_open( cn_coords_file(ib_bdy), inum ) 
    526518            DO igrd = 1, jpbgrd 
     
    537529                  nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
    538530               END DO 
    539  
     531               ! 
    540532               ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 
    541533               IF(lwp) WRITE(numout,*) 
     
    546538            END DO 
    547539            CALL iom_close( inum ) 
    548  
     540            ! 
    549541         ENDIF  
    550  
    551       ENDDO       
     542         ! 
     543      END DO       
    552544     
    553545      ! 2. Now fill indices corresponding to straight open boundary arrays: 
     
    792784 
    793785      ! Work out dimensions of boundary data on each neighbour process 
    794       IF(nbondi .eq. 0) THEN 
     786      IF(nbondi == 0) THEN 
    795787         iw_b(1) = jpizoom + nimppt(nowe+1) 
    796788         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
     
    802794         is_b(2) = jpjzoom + njmppt(noea+1) 
    803795         in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
    804       ELSEIF(nbondi .eq. 1) THEN 
     796      ELSEIF(nbondi == 1) THEN 
    805797         iw_b(1) = jpizoom + nimppt(nowe+1) 
    806798         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    807799         is_b(1) = jpjzoom + njmppt(nowe+1) 
    808800         in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    809       ELSEIF(nbondi .eq. -1) THEN 
     801      ELSEIF(nbondi == -1) THEN 
    810802         iw_b(2) = jpizoom + nimppt(noea+1) 
    811803         ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
     
    814806      ENDIF 
    815807 
    816       IF(nbondj .eq. 0) THEN 
     808      IF(nbondj == 0) THEN 
    817809         iw_b(3) = jpizoom + nimppt(noso+1) 
    818810         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
     
    824816         is_b(4) = jpjzoom + njmppt(nono+1) 
    825817         in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
    826       ELSEIF(nbondj .eq. 1) THEN 
     818      ELSEIF(nbondj == 1) THEN 
    827819         iw_b(3) = jpizoom + nimppt(noso+1) 
    828820         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    829821         is_b(3) = jpjzoom + njmppt(noso+1) 
    830822         in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
    831       ELSEIF(nbondj .eq. -1) THEN 
     823      ELSEIF(nbondj == -1) THEN 
    832824         iw_b(4) = jpizoom + nimppt(nono+1) 
    833825         ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
     
    867859         ! Allocate index arrays for this boundary set 
    868860         !-------------------------------------------- 
    869          ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 
    870          ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 
    871          ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 
    872          ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 
    873          ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) ) 
     861         ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 
     862         ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) ) 
     863         ALLOCATE( idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) ) 
     864         ALLOCATE( idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) ) 
     865         ALLOCATE( idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) ) 
    874866         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 
    875          ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 
    876          ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 
    877          ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) ) 
    878          ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) ) 
     867         ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ) 
     868         ALLOCATE( idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) ) 
     869         ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) ) 
     870         ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 
    879871 
    880872         ! Dispatch mapping indices and discrete distances on each processor 
    881873         ! ----------------------------------------------------------------- 
    882874 
    883          com_east = 0 
    884          com_west = 0 
     875         com_east  = 0 
     876         com_west  = 0 
    885877         com_south = 0 
    886878         com_north = 0 
    887879 
    888          com_east_b = 0 
    889          com_west_b = 0 
     880         com_east_b  = 0 
     881         com_west_b  = 0 
    890882         com_south_b = 0 
    891883         com_north_b = 0 
     
    912904                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 
    913905                     ij = idx_bdy(ib_bdy)%nbj(icount,igrd) 
    914                      if((com_east .ne. 1) .and. (ii .eq. (nlci-1)) .and. (nbondi .le. 0)) then 
     906                     if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then 
    915907                        com_east = 1 
    916                      elseif((com_west .ne. 1) .and. (ii .eq. 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 
     908                     elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 
    917909                        com_west = 1 
    918910                     endif  
    919                      if((com_south .ne. 1) .and. (ij .eq. 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 
     911                     if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 
    920912                        com_south = 1 
    921                      elseif((com_north .ne. 1) .and. (ij .eq. (nlcj-1)) .and. (nbondj .le. 0)) then 
     913                     elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then 
    922914                        com_north = 1 
    923915                     endif  
     
    926918                  ENDIF 
    927919                  ! check if point has to be received from a neighbour 
    928                   IF(nbondi .eq. 0) THEN 
     920                  IF(nbondi == 0) THEN 
    929921                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
    930922                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
    931923                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    932924                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    933                        if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then 
     925                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 
    934926                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    935                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     927                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    936928                            com_south = 1 
    937                           elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     929                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    938930                            com_north = 1 
    939931                          endif 
     
    945937                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    946938                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    947                        if((com_east_b .ne. 1) .and. (ii .eq. 2)) then 
     939                       if((com_east_b .ne. 1) .and. (ii == 2)) then 
    948940                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    949                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     941                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    950942                            com_south = 1 
    951                           elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     943                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    952944                            com_north = 1 
    953945                          endif 
     
    955947                       endif  
    956948                     ENDIF 
    957                   ELSEIF(nbondi .eq. 1) THEN 
     949                  ELSEIF(nbondi == 1) THEN 
    958950                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
    959951                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
    960952                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    961953                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    962                        if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then 
     954                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 
    963955                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    964                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     956                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    965957                            com_south = 1 
    966                           elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     958                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    967959                            com_north = 1 
    968960                          endif 
     
    970962                       endif  
    971963                     ENDIF 
    972                   ELSEIF(nbondi .eq. -1) THEN 
     964                  ELSEIF(nbondi == -1) THEN 
    973965                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   & 
    974966                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   & 
    975967                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    976968                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    977                        if((com_east_b .ne. 1) .and. (ii .eq. 2)) then 
     969                       if((com_east_b .ne. 1) .and. (ii == 2)) then 
    978970                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    979                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     971                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    980972                            com_south = 1 
    981                           elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     973                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    982974                            com_north = 1 
    983975                          endif 
     
    986978                     ENDIF 
    987979                  ENDIF 
    988                   IF(nbondj .eq. 0) THEN 
     980                  IF(nbondj == 0) THEN 
    989981                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  & 
    990982                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
     
    1001993                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1002994                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
    1003                        if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then 
     995                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 
    1004996                          com_south_b = 1 
    1005997                       endif  
     
    10091001                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    10101002                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
    1011                        if((com_north_b .ne. 1) .and. (ij .eq. 2)) then 
     1003                       if((com_north_b .ne. 1) .and. (ij == 2)) then 
    10121004                          com_north_b = 1 
    10131005                       endif  
    10141006                     ENDIF 
    1015                   ELSEIF(nbondj .eq. 1) THEN 
     1007                  ELSEIF(nbondj == 1) THEN 
    10161008                     IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. & 
    10171009                       & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & 
     
    10231015                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    10241016                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
    1025                        if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then 
     1017                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 
    10261018                          com_south_b = 1 
    10271019                       endif  
    10281020                     ENDIF 
    1029                   ELSEIF(nbondj .eq. -1) THEN 
     1021                  ELSEIF(nbondj == -1) THEN 
    10301022                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  & 
    10311023                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
     
    10371029                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    10381030                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
    1039                        if((com_north_b .ne. 1) .and. (ij .eq. 2)) then 
     1031                       if((com_north_b .ne. 1) .and. (ij == 2)) then 
    10401032                          com_north_b = 1 
    10411033                       endif  
     
    10461038         ENDDO  
    10471039 
    1048          ! definition of the i- and j- direction local boundaries arrays 
    1049          ! used for sending the boudaries 
    1050          IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN 
    1051             nbondi_bdy(ib_bdy) = 0 
    1052          ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN 
    1053             nbondi_bdy(ib_bdy) = -1 
    1054          ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN 
    1055             nbondi_bdy(ib_bdy) = 1 
     1040         ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries 
     1041         IF(     (com_east  == 1) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  0 
     1042         ELSEIF( (com_east  == 1) .and. (com_west  == 0) ) THEN   ;   nbondi_bdy(ib_bdy) = -1 
     1043         ELSEIF( (com_east  == 0) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  1 
    10561044         ENDIF 
    1057  
    1058          IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN 
    1059             nbondj_bdy(ib_bdy) = 0 
    1060          ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN 
    1061             nbondj_bdy(ib_bdy) = -1 
    1062          ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN 
    1063             nbondj_bdy(ib_bdy) = 1 
     1045         IF(     (com_north == 1) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  0 
     1046         ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN   ;   nbondj_bdy(ib_bdy) = -1 
     1047         ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  1 
    10641048         ENDIF 
    10651049 
    1066          ! definition of the i- and j- direction local boundaries arrays 
    1067          ! used for receiving the boudaries 
    1068          IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN 
    1069             nbondi_bdy_b(ib_bdy) = 0 
    1070          ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN 
    1071             nbondi_bdy_b(ib_bdy) = -1 
    1072          ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN 
    1073             nbondi_bdy_b(ib_bdy) = 1 
     1050         ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries 
     1051         IF(     (com_east_b  == 1) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  0 
     1052         ELSEIF( (com_east_b  == 1) .and. (com_west_b  == 0) ) THEN   ;   nbondi_bdy_b(ib_bdy) = -1 
     1053         ELSEIF( (com_east_b  == 0) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  1 
    10741054         ENDIF 
    1075  
    1076          IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN 
    1077             nbondj_bdy_b(ib_bdy) = 0 
    1078          ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN 
    1079             nbondj_bdy_b(ib_bdy) = -1 
    1080          ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN 
    1081             nbondj_bdy_b(ib_bdy) = 1 
     1055         IF(     (com_north_b == 1) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  0 
     1056         ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN   ;   nbondj_bdy_b(ib_bdy) = -1 
     1057         ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  1 
    10821058         ENDIF 
    10831059 
     
    10871063            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    10881064               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
    1089                idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation 
    1090 !               idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.  ! quadratic 
    1091 !               idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy))       ! linear 
     1065               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 )      ! tanh formulation 
     1066!               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic 
     1067!               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy))       ! linear 
    10921068            END DO 
    10931069         END DO  
     
    10991075               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
    11001076               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &  
    1101                & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1077               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    11021078               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) &  
    1103                & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1079               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    11041080            END DO 
    11051081         END DO  
     
    11221098 
    11231099         ! Derive mask on U and V grid from mask on T grid 
    1124          bdyumask(:,:) = 0.e0 
    1125          bdyvmask(:,:) = 0.e0 
     1100         bdyumask(:,:) = 0._wp 
     1101         bdyvmask(:,:) = 0._wp 
    11261102         DO ij=1, jpjm1 
    11271103            DO ii=1, jpim1 
    1128                bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 
    1129                bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)   
     1104               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
     1105               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    11301106            END DO 
    11311107         END DO 
     
    11411117                  umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij) 
    11421118                  vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij) 
    1143                   bmask(ii,ij)    = bmask(ii,ij)    * bdytmask(ii,ij) 
    11441119               END DO       
    11451120            END DO 
    1146          END DO 
    1147  
    1148          DO ik = 1, jpkm1 
    11491121            DO ij = 2, jpjm1 
    11501122               DO ii = 2, jpim1 
     
    11541126            END DO 
    11551127         END DO 
    1156  
    11571128         tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:) 
    1158  
     1129         ! 
    11591130      ENDIF ! ln_mask_file=.TRUE. 
    11601131       
    11611132      bdytmask(:,:) = ssmask(:,:) 
    1162       IF( .not. ln_mask_file ) THEN 
    1163          ! If .not. ln_mask_file then we need to derive mask on U and V grid  
    1164          ! from mask on T grid here. 
    1165          bdyumask(:,:) = 0.e0 
    1166          bdyvmask(:,:) = 0.e0 
    1167          DO ij=1, jpjm1 
    1168             DO ii=1, jpim1 
    1169                bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 
    1170                bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)   
     1133      IF( .NOT.ln_mask_file ) THEN 
     1134         ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 
     1135         bdyumask(:,:) = 0._wp 
     1136         bdyvmask(:,:) = 0._wp 
     1137         DO ij = 1, jpjm1 
     1138            DO ii = 1, jpim1 
     1139               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
     1140               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    11711141            END DO 
    11721142         END DO 
     
    11741144      ENDIF 
    11751145 
    1176       ! bdy masks and bmask are now set to zero on boundary points: 
    1177       igrd = 1       ! In the free surface case, bmask is at T-points 
    1178       DO ib_bdy = 1, nb_bdy 
    1179         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)      
    1180           bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
    1181         ENDDO 
    1182       ENDDO 
     1146      ! bdy masks are now set to zero on boundary points: 
    11831147      ! 
    11841148      igrd = 1 
    11851149      DO ib_bdy = 1, nb_bdy 
    11861150        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)       
    1187           bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
    1188         ENDDO 
    1189       ENDDO 
     1151          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
     1152        END DO 
     1153      END DO 
    11901154      ! 
    11911155      igrd = 2 
    11921156      DO ib_bdy = 1, nb_bdy 
    11931157        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1194           bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
    1195         ENDDO 
    1196       ENDDO 
     1158          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
     1159        END DO 
     1160      END DO 
    11971161      ! 
    11981162      igrd = 3 
    11991163      DO ib_bdy = 1, nb_bdy 
    12001164        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1201           bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
     1165          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
    12021166        ENDDO 
    12031167      ENDDO 
     
    12051169      ! For the flagu/flagv calculation below we require a version of fmask without 
    12061170      ! the land boundary condition (shlat) included: 
    1207       CALL wrk_alloc(jpi,jpj,zfmask)  
     1171      CALL wrk_alloc(jpi,jpj,  zfmask )  
    12081172      DO ij = 2, jpjm1 
    12091173         DO ii = 2, jpim1 
     
    12201184      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    12211185 
    1222          idx_bdy(ib_bdy)%flagu(:,:) = 0.e0 
    1223          idx_bdy(ib_bdy)%flagv(:,:) = 0.e0 
     1186         idx_bdy(ib_bdy)%flagu(:,:) = 0._wp 
     1187         idx_bdy(ib_bdy)%flagv(:,:) = 0._wp 
    12241188         icount = 0  
    12251189 
     
    12311195         DO igrd = 1,jpbgrd  
    12321196            SELECT CASE( igrd ) 
    1233                CASE( 1 ) 
    1234                   pmask => umask(:,:,1) 
    1235                   i_offset = 0 
    1236                CASE( 2 )  
    1237                   pmask => bdytmask 
    1238                   i_offset = 1 
    1239                CASE( 3 )  
    1240                   pmask => zfmask(:,:) 
    1241                   i_offset = 0 
     1197               CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0 
     1198               CASE( 2 )   ;   pmask => bdytmask(:,:)     ;   i_offset = 1 
     1199               CASE( 3 )   ;   pmask => zfmask  (:,:)     ;   i_offset = 0 
    12421200            END SELECT  
    12431201            icount = 0 
     
    12701228         ! flagv =  1 : v is normal to the boundary and is direction is inward 
    12711229 
    1272          DO igrd = 1,jpbgrd  
     1230         DO igrd = 1, jpbgrd  
    12731231            SELECT CASE( igrd ) 
    1274                CASE( 1 ) 
    1275                   pmask => vmask(:,:,1) 
    1276                   j_offset = 0 
    1277                CASE( 2 ) 
    1278                   pmask => zfmask(:,:) 
    1279                   j_offset = 0 
    1280                CASE( 3 ) 
    1281                   pmask => bdytmask 
    1282                   j_offset = 1 
     1232               CASE( 1 )   ;   pmask => vmask (:,:,1)   ;   j_offset = 0 
     1233               CASE( 2 )   ;   pmask => zfmask(:,:)     ;   j_offset = 0 
     1234               CASE( 3 )   ;   pmask => bdytmask        ;   j_offset = 1 
    12831235            END SELECT  
    12841236            icount = 0 
     
    12861238               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    12871239               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1288                znfl = pmask(nbi,nbj+j_offset-1  ) 
    1289                zsfl = pmask(nbi,nbj+j_offset) 
     1240               znfl = pmask(nbi,nbj+j_offset-1) 
     1241               zsfl = pmask(nbi,nbj+j_offset  ) 
    12901242               ! This error check only works if you are using the bdyXmask arrays 
    12911243               IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 
     
    13051257            ENDIF  
    13061258         END DO 
    1307  
     1259         ! 
    13081260      END DO 
    13091261 
     
    13231275                  &                    * tmask_i(nbi  , nbj)                           & 
    13241276                  &                    * tmask_i(nbi+1, nbj)                    
    1325             ENDDO 
    1326          ENDDO 
     1277            END DO 
     1278         END DO 
    13271279 
    13281280         igrd=3 ! Add lateral surface at V-points 
     
    13361288                  &                    * tmask_i(nbi, nbj  )                           & 
    13371289                  &                    * tmask_i(nbi, nbj+1) 
    1338             ENDDO 
    1339          ENDDO 
     1290            END DO 
     1291         END DO 
    13401292         ! 
    13411293         IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain 
     
    13441296      ! Tidy up 
    13451297      !-------- 
    1346       IF (nb_bdy>0) THEN 
    1347          DEALLOCATE(nbidta, nbjdta, nbrdta) 
    1348       ENDIF 
    1349  
    1350       CALL wrk_dealloc(jpi,jpj,zfmask)  
    1351  
    1352       IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 
    1353  
     1298      IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta ) 
     1299      ! 
     1300      CALL wrk_dealloc(jpi,jpj,   zfmask )  
     1301      ! 
     1302      IF( nn_timing == 1 )   CALL timing_stop('bdy_init') 
     1303      ! 
    13541304   END SUBROUTINE bdy_init 
     1305 
    13551306 
    13561307   SUBROUTINE bdy_ctl_seg 
     
    17431694      itest = 0 
    17441695 
    1745       IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1 
    1746       IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1 
    1747       IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1 
    1748       ! 
    1749       IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1 
    1750       IF (nn_dyn3d_dta(ib1)/=nn_dyn3d_dta(ib2)) itest = itest + 1 
    1751       IF (nn_tra_dta(ib1)/=nn_tra_dta(ib2)) itest = itest + 1 
    1752       ! 
    1753       IF (nn_rimwidth(ib1)/=nn_rimwidth(ib2)) itest = itest + 1    
    1754       ! 
    1755       IF ( itest>0 ) THEN 
     1696      IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) )  itest = itest + 1 
     1697      IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) )  itest = itest + 1 
     1698      IF( cn_tra  (ib1) /= cn_tra  (ib2) )  itest = itest + 1 
     1699      ! 
     1700      IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) )  itest = itest + 1 
     1701      IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) )  itest = itest + 1 
     1702      IF( nn_tra_dta  (ib1) /= nn_tra_dta  (ib2) )  itest = itest + 1 
     1703      ! 
     1704      IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) )  itest = itest + 1    
     1705      ! 
     1706      IF( itest>0 ) THEN 
    17561707         IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2 
    17571708         IF(lwp) WRITE(numout,*) ' ==========  have different open bdy schemes'                                                   
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90

    r5215 r6004  
    44   !! Unstructured Open Boundary Cond. :  Library module of generic boundary algorithms. 
    55   !!====================================================================== 
    6    !! History :  3.6  !  2013     (D. Storkey) new module 
     6   !! History :  3.6  !  2013     (D. Storkey) original code 
    77   !!---------------------------------------------------------------------- 
    88#if defined key_bdy  
     
    1313   !!   bdy_orlanski_3d 
    1414   !!---------------------------------------------------------------------- 
    15    USE timing          ! Timing 
    16    USE oce             ! ocean dynamics and tracers  
    17    USE dom_oce         ! ocean space and time domain 
    18    USE bdy_oce         ! ocean open boundary conditions 
    19    USE phycst          ! physical constants 
    20    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    21    USE in_out_manager  ! 
     15   USE oce            ! ocean dynamics and tracers  
     16   USE dom_oce        ! ocean space and time domain 
     17   USE bdy_oce        ! ocean open boundary conditions 
     18   USE phycst         ! physical constants 
     19   ! 
     20   USE in_out_manager ! 
     21   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     22   USE timing         ! Timing 
    2223 
    2324   IMPLICIT NONE 
     
    4546      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    4647      !!---------------------------------------------------------------------- 
    47       TYPE(OBC_INDEX),            INTENT(in)    ::   idx      ! BDY indices 
    48       INTEGER,                    INTENT(in)    ::   igrd     ! grid index 
    49       REAL(wp), DIMENSION(:,:),   INTENT(in)    ::   phib     ! model before 2D field 
    50       REAL(wp), DIMENSION(:,:),   INTENT(inout) ::   phia     ! model after 2D field (to be updated) 
    51       REAL(wp), DIMENSION(:),     INTENT(in)    ::   phi_ext  ! external forcing data 
    52       LOGICAL,                    INTENT(in)    ::   ll_npo   ! switch for NPO version 
    53  
     48      TYPE(OBC_INDEX),          INTENT(in   ) ::   idx      ! BDY indices 
     49      INTEGER ,                 INTENT(in   ) ::   igrd     ! grid index 
     50      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   phib     ! model before 2D field 
     51      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   phia     ! model after 2D field (to be updated) 
     52      REAL(wp), DIMENSION(:)  , INTENT(in   ) ::   phi_ext  ! external forcing data 
     53      LOGICAL ,                 INTENT(in   ) ::   ll_npo   ! switch for NPO version 
     54      ! 
    5455      INTEGER  ::   jb                                     ! dummy loop indices 
    5556      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses 
     
    7071      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    7172      !!---------------------------------------------------------------------- 
    72  
    73       IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_2d') 
    74  
     73      ! 
     74      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_2d') 
     75      ! 
    7576      ! ----------------------------------! 
    7677      ! Orlanski boundary conditions     :! 
     
    7980      SELECT CASE(igrd) 
    8081         CASE(1) 
    81             pmask => tmask(:,:,1) 
     82            pmask      => tmask(:,:,1) 
    8283            pmask_xdif => umask(:,:,1) 
    8384            pmask_ydif => vmask(:,:,1) 
    84             pe_xdif => e1u(:,:) 
    85             pe_ydif => e2v(:,:) 
     85            pe_xdif    => e1u(:,:) 
     86            pe_ydif    => e2v(:,:) 
    8687            ii_offset = 0 
    8788            ij_offset = 0 
    8889         CASE(2) 
    89             pmask => umask(:,:,1) 
     90            pmask      => umask(:,:,1) 
    9091            pmask_xdif => tmask(:,:,1) 
    9192            pmask_ydif => fmask(:,:,1) 
    92             pe_xdif => e1t(:,:) 
    93             pe_ydif => e2f(:,:) 
     93            pe_xdif    => e1t(:,:) 
     94            pe_ydif    => e2f(:,:) 
    9495            ii_offset = 1 
    9596            ij_offset = 0 
    9697         CASE(3) 
    97             pmask => vmask(:,:,1) 
     98            pmask      => vmask(:,:,1) 
    9899            pmask_xdif => fmask(:,:,1) 
    99100            pmask_ydif => tmask(:,:,1) 
    100             pe_xdif => e1f(:,:) 
    101             pe_ydif => e2t(:,:) 
     101            pe_xdif    => e1f(:,:) 
     102            pe_ydif    => e2t(:,:) 
    102103            ii_offset = 0 
    103104            ij_offset = 1 
     
    188189      END DO 
    189190      ! 
    190       IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_2d') 
    191  
     191      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_2d') 
     192      ! 
    192193   END SUBROUTINE bdy_orlanski_2d 
    193194 
     
    204205      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    205206      !!---------------------------------------------------------------------- 
    206       TYPE(OBC_INDEX),            INTENT(in)    ::   idx      ! BDY indices 
    207       INTEGER,                    INTENT(in)    ::   igrd     ! grid index 
    208       REAL(wp), DIMENSION(:,:,:), INTENT(in)    ::   phib     ! model before 3D field 
    209       REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated) 
    210       REAL(wp), DIMENSION(:,:),   INTENT(in)    ::   phi_ext  ! external forcing data 
    211       LOGICAL,                    INTENT(in)    ::   ll_npo   ! switch for NPO version 
    212  
     207      TYPE(OBC_INDEX),            INTENT(in   ) ::   idx      ! BDY indices 
     208      INTEGER ,                   INTENT(in   ) ::   igrd     ! grid index 
     209      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   phib     ! model before 3D field 
     210      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phia     ! model after 3D field (to be updated) 
     211      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   phi_ext  ! external forcing data 
     212      LOGICAL ,                   INTENT(in   ) ::   ll_npo   ! switch for NPO version 
     213      ! 
    213214      INTEGER  ::   jb, jk                                 ! dummy loop indices 
    214215      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses 
     
    229230      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    230231      !!---------------------------------------------------------------------- 
    231  
    232       IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_3d') 
    233  
     232      ! 
     233      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_3d') 
     234      ! 
    234235      ! ----------------------------------! 
    235236      ! Orlanski boundary conditions     :! 
    236237      ! ----------------------------------!  
    237       
     238      ! 
    238239      SELECT CASE(igrd) 
    239240         CASE(1) 
    240             pmask => tmask(:,:,:) 
     241            pmask      => tmask(:,:,:) 
    241242            pmask_xdif => umask(:,:,:) 
    242243            pmask_ydif => vmask(:,:,:) 
    243             pe_xdif => e1u(:,:) 
    244             pe_ydif => e2v(:,:) 
     244            pe_xdif    => e1u(:,:) 
     245            pe_ydif    => e2v(:,:) 
    245246            ii_offset = 0 
    246247            ij_offset = 0 
    247248         CASE(2) 
    248             pmask => umask(:,:,:) 
     249            pmask      => umask(:,:,:) 
    249250            pmask_xdif => tmask(:,:,:) 
    250251            pmask_ydif => fmask(:,:,:) 
    251             pe_xdif => e1t(:,:) 
    252             pe_ydif => e2f(:,:) 
     252            pe_xdif    => e1t(:,:) 
     253            pe_ydif    => e2f(:,:) 
    253254            ii_offset = 1 
    254255            ij_offset = 0 
    255256         CASE(3) 
    256             pmask => vmask(:,:,:) 
     257            pmask      => vmask(:,:,:) 
    257258            pmask_xdif => fmask(:,:,:) 
    258259            pmask_ydif => tmask(:,:,:) 
    259             pe_xdif => e1f(:,:) 
    260             pe_ydif => e2t(:,:) 
     260            pe_xdif    => e1f(:,:) 
     261            pe_ydif    => e2t(:,:) 
    261262            ii_offset = 0 
    262263            ij_offset = 1 
     
    349350         ! 
    350351      END DO 
    351  
    352       IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_3d') 
    353  
     352      ! 
     353      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_3d') 
     354      ! 
    354355   END SUBROUTINE bdy_orlanski_3d 
    355356 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r5845 r6004  
    1515   !!   'key_bdy'     Open Boundary Condition 
    1616   !!---------------------------------------------------------------------- 
    17    !!   PUBLIC 
    18    !!      bdytide_init     : read of namelist and initialisation of tidal harmonics data 
    19    !!      tide_update   : calculation of tidal forcing at each timestep 
    20    !!---------------------------------------------------------------------- 
    21    USE timing          ! Timing 
    22    USE oce             ! ocean dynamics and tracers  
    23    USE dom_oce         ! ocean space and time domain 
    24    USE iom 
    25    USE in_out_manager  ! I/O units 
    26    USE phycst          ! physical constants 
    27    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    28    USE bdy_par         ! Unstructured boundary parameters 
    29    USE bdy_oce         ! ocean open boundary conditions 
    30    USE daymod          ! calendar 
    31    USE wrk_nemo        ! Memory allocation 
    32    USE tideini 
    33 !   USE tide_mod       ! Useless ?? 
    34    USE fldread 
    35    USE dynspg_oce, ONLY: lk_dynspg_ts 
     17   !!   bdytide_init  : read of namelist and initialisation of tidal harmonics data 
     18   !!   tide_update   : calculation of tidal forcing at each timestep 
     19   !!---------------------------------------------------------------------- 
     20   USE oce            ! ocean dynamics and tracers  
     21   USE dom_oce        ! ocean space and time domain 
     22   USE phycst         ! physical constants 
     23   USE bdy_par        ! Unstructured boundary parameters 
     24   USE bdy_oce        ! ocean open boundary conditions 
     25   USE tideini        !  
     26   USE daymod         ! calendar 
     27   ! 
     28   USE in_out_manager ! I/O units 
     29   USE iom            ! xIO server 
     30   USE fldread        ! 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     32   USE wrk_nemo       ! Memory allocation 
     33   USE timing         ! timing 
    3634 
    3735   IMPLICIT NONE 
     
    4341 
    4442   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data 
    45       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0       !: Tidal constituents : SSH0 (read in file) 
    46       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0         !: Tidal constituents : U0   (read in file) 
    47       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v0         !: Tidal constituents : V0   (read in file) 
    48       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH  (after nodal cor.) 
    49       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U    (after nodal cor.) 
    50       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.) 
     43      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0     !: Tidal constituents : SSH0   (read in file) 
     44      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0, v0   !: Tidal constituents : U0, V0 (read in file) 
     45      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh      !: Tidal constituents : SSH    (after nodal cor.) 
     46      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u , v    !: Tidal constituents : U , V  (after nodal cor.) 
    5147   END TYPE TIDES_DATA 
    5248 
     
    5450   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data 
    5551!$AGRIF_END_DO_NOT_TREAT 
    56    TYPE(OBC_DATA)  , PRIVATE, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component) 
     52   TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component) 
    5753 
    5854   !!---------------------------------------------------------------------- 
     
    9288      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 
    9389      !!---------------------------------------------------------------------- 
    94  
    95       IF( nn_timing == 1 ) CALL timing_start('bdytide_init') 
    96  
     90      ! 
     91      IF( nn_timing == 1 )   CALL timing_start('bdytide_init') 
     92      ! 
    9793      IF (nb_bdy>0) THEN 
    9894         IF(lwp) WRITE(numout,*) 
     
    264260            ENDIF ! ln_bdytide_2ddta=.true. 
    265261            ! 
    266             IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files 
     262            IF( ln_bdytide_conj ) THEN    ! assume complex conjugate in data files 
    267263               td%ssh0(:,:,2) = - td%ssh0(:,:,2) 
    268264               td%u0  (:,:,2) = - td%u0  (:,:,2) 
     
    270266            ENDIF 
    271267            ! 
    272             IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during 
    273                                      ! time splitting integration 
    274                ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
    275                ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
    276                ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
    277                dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 
    278                dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 
    279                dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 
    280             ENDIF 
     268            ! Allocate slow varying data in the case of time splitting: 
     269            ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
     270            ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
     271            ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
     272            ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
     273            dta_bdy_s(ib_bdy)%ssh(:) = 0._wp 
     274            dta_bdy_s(ib_bdy)%u2d(:) = 0._wp 
     275            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    281276            ! 
    282277         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
    283278         ! 
    284279      END DO ! loop on ib_bdy 
    285  
    286       IF( nn_timing == 1 ) CALL timing_stop('bdytide_init') 
    287  
     280      ! 
     281      IF( nn_timing == 1 )   CALL timing_stop('bdytide_init') 
     282      ! 
    288283   END SUBROUTINE bdytide_init 
    289284 
    290285 
    291    SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset ) 
     286   SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset ) 
    292287      !!---------------------------------------------------------------------- 
    293288      !!                 ***  SUBROUTINE bdytide_update  *** 
     
    308303      !                                                 ! etc. 
    309304      ! 
    310       INTEGER                          :: itide, igrd, ib   ! dummy loop indices 
    311       INTEGER                          :: time_add          ! time offset in units of timesteps 
    312       INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays) 
    313       REAL(wp)                         :: z_arg, z_sarg, zflag, zramp       
     305      INTEGER  ::   itide, igrd, ib       ! dummy loop indices 
     306      INTEGER  ::   time_add              ! time offset in units of timesteps 
     307      INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays) 
     308      REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars     
    314309      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 
    315310      !!---------------------------------------------------------------------- 
    316  
    317       IF( nn_timing == 1 ) CALL timing_start('bdytide_update') 
    318  
     311      ! 
     312      IF( nn_timing == 1 )   CALL timing_start('bdytide_update') 
     313      ! 
    319314      ilen0(1) =  SIZE(td%ssh(:,1,1)) 
    320315      ilen0(2) =  SIZE(td%u(:,1,1)) 
     
    377372      END DO 
    378373      ! 
    379       IF( nn_timing == 1 ) CALL timing_stop('bdytide_update') 
     374      IF( nn_timing == 1 )   CALL timing_stop('bdytide_update') 
    380375      ! 
    381376   END SUBROUTINE bdytide_update 
     
    398393      !                                              ! etc. 
    399394      ! 
    400       LOGICAL  :: lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
    401       INTEGER  :: itide, ib_bdy, ib, igrd   ! loop indices 
    402       INTEGER  :: time_add                  ! time offset in units of timesteps 
    403       INTEGER, DIMENSION(jpbgrd) :: ilen0  
    404       INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim  ! short cuts 
    405       REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
    406       !!---------------------------------------------------------------------- 
    407  
    408       IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides') 
    409  
     395      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
     396      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
     397      INTEGER  ::   time_add                  ! time offset in units of timesteps 
     398      INTEGER, DIMENSION(jpbgrd)   ::  ilen0  
     399      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
     400      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
     401      !!---------------------------------------------------------------------- 
     402      ! 
     403      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_tides') 
     404      ! 
    410405      lk_first_btstp=.TRUE. 
    411406      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF 
     
    418413      ! Absolute time from model initialization:    
    419414      IF( PRESENT(kit) ) THEN   
    420          z_arg = ( kt + (kit+0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt 
     415         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 
    421416      ELSE                               
    422417         z_arg = ( kt + time_add ) * rdt 
     
    458453            zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 
    459454            ! 
    460             ! If time splitting, save data at first barotropic iteration 
    461             IF ( PRESENT(kit) ) THEN 
    462                IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data: 
    463                   IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 
    464                   IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 
    465                   IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 
    466  
    467                ELSE ! Initialize arrays from slow varying open boundary data:             
    468                   IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    469                   IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    470                   IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    471                ENDIF 
     455            ! If time splitting, initialize arrays from slow varying open boundary data: 
     456            IF ( PRESENT(kit) ) THEN            
     457               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
     458               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
     459               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    472460            ENDIF 
    473461            ! 
     
    525513      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    526514      !!---------------------------------------------------------------------- 
    527  
     515      ! 
    528516      igrd=1    
    529517                              ! SSH on tracer grid. 
    530     
    531518      ilen0(1) =  SIZE(td%ssh0(:,1,1)) 
    532  
    533       ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd))) 
    534  
     519      ! 
     520      ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 
     521      ! 
    535522      DO itide = 1, nb_harmo 
    536523         DO ib = 1, ilen0(igrd) 
     
    547534         ENDDO 
    548535      END DO 
    549  
     536      ! 
    550537      DEALLOCATE( mod_tide, phi_tide ) 
    551538      ! 
     
    564551      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    565552      !!---------------------------------------------------------------------- 
    566  
     553      ! 
    567554      ilen0(2) =  SIZE(td%u0(:,1,1)) 
    568555      ilen0(3) =  SIZE(td%v0(:,1,1)) 
    569  
     556      ! 
    570557      igrd=2                                 ! U grid. 
    571  
     558      ! 
    572559      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    573  
     560      ! 
    574561      DO itide = 1, nb_harmo 
    575562         DO ib = 1, ilen0(igrd) 
     
    586573         ENDDO 
    587574      END DO 
    588  
     575      ! 
    589576      DEALLOCATE( mod_tide , phi_tide ) 
    590  
     577      ! 
    591578      igrd=3                                 ! V grid. 
    592  
     579      ! 
    593580      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    594581 
     
    608595      END DO 
    609596      ! 
    610       DEALLOCATE(mod_tide,phi_tide) 
     597      DEALLOCATE( mod_tide, phi_tide ) 
    611598      ! 
    612599  END SUBROUTINE tide_init_velocities 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r4292 r6004  
    1616   !!   bdy_tra_frs        : Apply Flow Relaxation Scheme 
    1717   !!---------------------------------------------------------------------- 
    18    USE timing          ! Timing 
    19    USE oce             ! ocean dynamics and tracers variables 
    20    USE dom_oce         ! ocean space and time domain variables  
    21    USE bdy_oce         ! ocean open boundary conditions 
    22    USE bdylib          ! for orlanski library routines 
    23    USE bdydta, ONLY:   bf 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25    USE in_out_manager  ! I/O manager 
    26  
     18   USE oce            ! ocean dynamics and tracers variables 
     19   USE dom_oce        ! ocean space and time domain variables  
     20   USE bdy_oce        ! ocean open boundary conditions 
     21   USE bdylib         ! for orlanski library routines 
     22   USE bdydta   , ONLY:   bf   !  
     23   ! 
     24   USE in_out_manager ! I/O manager 
     25   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     26   USE timing         ! Timing 
    2727 
    2828   IMPLICIT NONE 
    2929   PRIVATE 
    3030 
    31    PUBLIC bdy_tra      ! routine called in tranxt.F90  
    32    PUBLIC bdy_tra_dmp  ! routine called in step.F90  
     31   PUBLIC   bdy_tra      ! called in tranxt.F90  
     32   PUBLIC   bdy_tra_dmp  ! called in step.F90  
    3333 
    3434   !!---------------------------------------------------------------------- 
     
    4646      !! 
    4747      !!---------------------------------------------------------------------- 
    48       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    49       !! 
    50       INTEGER               :: ib_bdy ! Loop index 
     48      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
     49      ! 
     50      INTEGER ::   ib_bdy   ! Loop index 
     51      !!---------------------------------------------------------------------- 
    5152 
    5253      DO ib_bdy=1, nb_bdy 
    53  
     54         ! 
    5455         SELECT CASE( cn_tra(ib_bdy) ) 
    55          CASE('none') 
    56             CYCLE 
    57          CASE('frs') 
    58             CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    59          CASE('specified') 
    60             CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    61          CASE('neumann') 
    62             CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    63          CASE('orlanski') 
    64             CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
    65          CASE('orlanski_npo') 
    66             CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
    67          CASE('runoff') 
    68             CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    69          CASE DEFAULT 
    70             CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     56         CASE('none'        )   ;   CYCLE 
     57         CASE('frs'         )   ;   CALL bdy_tra_frs     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     58         CASE('specified'   )   ;   CALL bdy_tra_spe     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     59         CASE('neumann'     )   ;   CALL bdy_tra_nmn     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     60         CASE('orlanski'    )   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
     61         CASE('orlanski_npo')   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
     62         CASE('runoff'      )   ;   CALL bdy_tra_rnf     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     63         CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    7164         END SELECT 
    7265         ! Boundary points should be updated 
    7366         CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 
    7467         CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 
    75       ENDDO 
    76       ! 
    77  
     68      END DO 
     69      ! 
    7870   END SUBROUTINE bdy_tra 
    7971 
     72 
    8073   SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
    8174      !!---------------------------------------------------------------------- 
     
    8679      !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    8780      !!---------------------------------------------------------------------- 
    88       INTEGER,         INTENT(in) ::   kt 
    89       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    90       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    91       !!  
     81      INTEGER,         INTENT(in) ::   kt    ! 
     82      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
     83      TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
     84      ! 
    9285      REAL(wp) ::   zwgt           ! boundary weight 
    9386      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     
    9588      !!---------------------------------------------------------------------- 
    9689      ! 
    97       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs') 
     90      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs') 
    9891      ! 
    9992      igrd = 1                       ! Everything is at T-points here 
     
    108101      END DO  
    109102      ! 
    110       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    111       ! 
    112       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs') 
     103      IF( kt .eq. nit000 )   CLOSE( unit = 102 ) 
     104      ! 
     105      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs') 
    113106      ! 
    114107   END SUBROUTINE bdy_tra_frs 
    115    
     108 
     109 
    116110   SUBROUTINE bdy_tra_spe( idx, dta, kt ) 
    117111      !!---------------------------------------------------------------------- 
     
    121115      !!  
    122116      !!---------------------------------------------------------------------- 
    123       INTEGER,         INTENT(in) ::   kt 
    124       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    125       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    126       !!  
     117      INTEGER,         INTENT(in) ::   kt    ! 
     118      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
     119      TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
     120      ! 
    127121      REAL(wp) ::   zwgt           ! boundary weight 
    128122      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     
    142136      END DO 
    143137      ! 
    144       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    145       ! 
    146       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 
     138      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     139      ! 
     140      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe') 
    147141      ! 
    148142   END SUBROUTINE bdy_tra_spe 
    149143 
     144 
    150145   SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 
    151146      !!---------------------------------------------------------------------- 
     
    155150      !!  
    156151      !!---------------------------------------------------------------------- 
    157       INTEGER,         INTENT(in) ::   kt 
    158       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    159       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    160       !!  
     152      INTEGER,         INTENT(in) ::   kt    !  
     153      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
     154      TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
     155      ! 
    161156      REAL(wp) ::   zwgt           ! boundary weight 
    162157      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     
    164159      !!---------------------------------------------------------------------- 
    165160      ! 
    166       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 
     161      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_nmn') 
    167162      ! 
    168163      igrd = 1                       ! Everything is at T-points here 
     
    196191      END DO 
    197192      ! 
    198       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    199       ! 
    200       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 
     193      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     194      ! 
     195      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_nmn') 
    201196      ! 
    202197   END SUBROUTINE bdy_tra_nmn 
     
    213208      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    214209      !!---------------------------------------------------------------------- 
    215       TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    216       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    217       LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
    218  
     210      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     211      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
     212      LOGICAL        , INTENT(in) ::   ll_npo  ! switch for NPO version 
     213      ! 
    219214      INTEGER  ::   igrd                                    ! grid index 
    220215      !!---------------------------------------------------------------------- 
    221  
     216      ! 
    222217      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
    223218      ! 
     
    230225      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
    231226      ! 
    232       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 
    233       ! 
    234  
     227      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski') 
     228      ! 
    235229   END SUBROUTINE bdy_tra_orlanski 
    236230 
     
    245239      !!  
    246240      !!---------------------------------------------------------------------- 
    247       INTEGER,         INTENT(in) ::   kt 
    248       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    249       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    250       !!  
     241      INTEGER        , INTENT(in) ::   kt    !  
     242      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
     243      TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
     244      ! 
    251245      REAL(wp) ::   zwgt           ! boundary weight 
    252246      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     
    254248      !!---------------------------------------------------------------------- 
    255249      ! 
    256       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf') 
     250      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf') 
    257251      ! 
    258252      igrd = 1                       ! Everything is at T-points here 
     
    268262      END DO 
    269263      ! 
    270       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    271       ! 
    272       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 
     264      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     265      ! 
     266      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf') 
    273267      ! 
    274268   END SUBROUTINE bdy_tra_rnf 
    275269 
     270 
    276271   SUBROUTINE bdy_tra_dmp( kt ) 
    277272      !!---------------------------------------------------------------------- 
     
    281276      !!  
    282277      !!---------------------------------------------------------------------- 
    283       INTEGER,         INTENT(in) ::   kt 
    284       !!  
     278      INTEGER, INTENT(in) ::   kt   ! 
     279      ! 
    285280      REAL(wp) ::   zwgt           ! boundary weight 
    286281      REAL(wp) ::   zta, zsa, ztime 
     
    290285      !!---------------------------------------------------------------------- 
    291286      ! 
    292       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp') 
    293       ! 
    294       DO ib_bdy=1, nb_bdy 
    295          IF ( ln_tra_dmp(ib_bdy) ) THEN 
     287      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_dmp') 
     288      ! 
     289      DO ib_bdy = 1, nb_bdy 
     290         IF( ln_tra_dmp(ib_bdy) ) THEN 
    296291            igrd = 1                       ! Everything is at T-points here 
    297292            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
     
    307302            END DO 
    308303         ENDIF 
    309       ENDDO 
    310       ! 
    311       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp') 
     304      END DO 
     305      ! 
     306      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_dmp') 
    312307      ! 
    313308   END SUBROUTINE bdy_tra_dmp 
     
    325320      WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 
    326321   END SUBROUTINE bdy_tra_dmp 
    327  
    328322#endif 
    329323 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r5845 r6004  
    1010   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    1111   !!---------------------------------------------------------------------- 
    12 #if   defined key_bdy   &&   defined key_dynspg_flt 
     12#if defined key_bdy 
    1313   !!---------------------------------------------------------------------- 
    14    !!   'key_bdy'            AND      unstructured open boundary conditions 
    15    !!   'key_dynspg_flt'                              filtered free surface 
     14   !!   'key_bdy'                     unstructured open boundary conditions 
    1615   !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers  
    18    USE bdy_oce         ! ocean open boundary conditions 
    19    USE sbc_oce         ! ocean surface boundary conditions 
    20    USE dom_oce         ! ocean space and time domain  
    21    USE phycst          ! physical constants 
    22    USE sbcisf          ! ice shelf 
     16   USE oce            ! ocean dynamics and tracers  
     17   USE bdy_oce        ! ocean open boundary conditions 
     18   USE sbc_oce        ! ocean surface boundary conditions 
     19   USE dom_oce        ! ocean space and time domain  
     20   USE phycst         ! physical constants 
     21   USE sbcisf         ! ice shelf 
    2322   ! 
    24    USE in_out_manager  ! I/O manager 
    25    USE lib_mpp         ! for mppsum 
    26    USE timing          ! Timing 
    27    USE lib_fortran     ! Fortran routines library 
     23   USE in_out_manager ! I/O manager 
     24   USE lib_mpp        ! for mppsum 
     25   USE timing         ! Timing 
     26   USE lib_fortran    ! Fortran routines library 
    2827 
    2928   IMPLICIT NONE 
    3029   PRIVATE 
    3130 
    32    PUBLIC bdy_vol        ! routine called by dynspg_flt.h90 
     31   PUBLIC   bdy_vol    ! called by ??? 
    3332 
    3433   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.6 , NEMO Consortium (2014) 
     34   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    3635   !! $Id$  
    3736   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    4342      !!                      ***  ROUTINE bdyvol  *** 
    4443      !! 
    45       !! ** Purpose :   This routine is called in dynspg_flt to control  
    46       !!      the volume of the system. A correction velocity is calculated 
    47       !!      to correct the total transport through the unstructured OBC.  
     44      !! ** Purpose :   This routine controls the volume of the system.  
     45      !!      A correction velocity is calculated to correct the total transport  
     46      !!      through the unstructured OBC.  
    4847      !!      The total depth used is constant (H0) to be consistent with the  
    49       !!      linear free surface coded in OPA 8.2 
     48      !!      linear free surface coded in OPA 8.2    <<<=== !!gm  ???? true ???? 
    5049      !! 
    5150      !! ** Method  :   The correction velocity (zubtpecor here) is defined calculating 
     
    7170      !!            (set nn_volctl to 1 in tne namelist for this option) 
    7271      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    74       !! 
     72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     73      ! 
    7574      INTEGER  ::   ji, jj, jk, jb, jgrd 
    7675      INTEGER  ::   ib_bdy, ii, ij 
     
    126125      ! The normal velocity correction 
    127126      ! ------------------------------ 
    128       IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot  
    129       ELSE                      ;   zubtpecor =   zubtpecor             / bdysurftot 
     127      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot  
     128      ELSE                      ;   zubtpecor =   zubtpecor               / bdysurftot 
    130129      END IF 
    131130 
     
    160159      ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 
    161160      ! ------------------------------------------------------ 
    162       IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
     161      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN 
    163162         IF(lwp) WRITE(numout,*) 
    164163         IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt 
     
    170169      END IF  
    171170      ! 
    172       IF( nn_timing == 1 ) CALL timing_stop('bdy_vol') 
     171      IF( nn_timing == 1 )   CALL timing_stop('bdy_vol') 
    173172      ! 
    174173      END IF ! ln_vol 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90

    r5836 r6004  
    44   !! Ocean domain  :  1D configuration 
    55   !!===================================================================== 
    6    !! History :   2.0  !  2004-09 (C. Ethe)     Original code 
    7    !!             3.0  !  2008-04 (G. Madec)    adaptation to SBC 
    8    !!             3.5  !  2013-10 (D. Calvert)  add namelist 
     6   !! History :  2.0  !  2004-09 (C. Ethe)     Original code 
     7   !!            3.0  !  2008-04 (G. Madec)    adaptation to SBC 
     8   !!            3.5  !  2013-10 (D. Calvert)  add namelist 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_c1d 
     
    1212   !!   'key_c1d'                                   1D column configuration 
    1313   !!---------------------------------------------------------------------- 
    14    !!   c1d_init       : read in the C1D namelist 
     14   !!   c1d_init      : read in the C1D namelist 
    1515   !!---------------------------------------------------------------------- 
    16    USE in_out_manager   ! I/O manager 
    17    USE par_kind         ! kind parameters 
    18    USE lib_mpp 
     16   USE par_kind       ! kind parameters 
     17   ! 
     18   USE in_out_manager ! I/O manager 
     19   USE lib_mpp        ! MPP library 
    1920 
    2021   IMPLICIT NONE 
    2122   PRIVATE 
    2223 
    23    PUBLIC   c1d_init                                 ! called by nemogcm.F90 
     24   PUBLIC   c1d_init   ! called by nemogcm.F90 
    2425 
    2526   LOGICAL , PUBLIC, PARAMETER ::  lk_c1d = .TRUE.   ! 1D config. flag 
    2627 
    27    REAL(wp), PUBLIC            ::  rn_lat1d     ! Column latitude 
    28    REAL(wp), PUBLIC            ::  rn_lon1d     ! Column longitude 
    29    LOGICAL , PUBLIC            ::  ln_c1d_locpt ! Localization (or not) of 1D column in a grid 
     28   REAL(wp), PUBLIC ::  rn_lat1d     !: Column latitude 
     29   REAL(wp), PUBLIC ::  rn_lon1d     !: Column longitude 
     30   LOGICAL , PUBLIC ::  ln_c1d_locpt !: Localization (or not) of 1D column in a grid 
    3031 
    3132   !!---------------------------------------------------------------------- 
    32    !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
     33   !! NEMO/C1D 3.7 , NEMO Consortium (2015) 
    3334   !! $Id$  
    3435   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4445      !! ** Method  :   Read namelist namc1d  
    4546      !!---------------------------------------------------------------------- 
    46       INTEGER ::   ios                 ! Local integer output status for namelist read 
     47      INTEGER ::   ios   ! Local integer 
     48      !! 
    4749      NAMELIST/namc1d/ rn_lat1d, rn_lon1d , ln_c1d_locpt 
    4850      !!---------------------------------------------------------------------- 
     
    5052      REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme 
    5153      READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901) 
    52 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp ) 
    53  
     54901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp ) 
     55      ! 
    5456      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 
    5557      READ  ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 ) 
    56 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 
     58902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 
    5759      IF(lwm) WRITE ( numond, namc1d ) 
    5860      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    r5215 r6004  
    1212   !!   dom_c1d     : Determine jpizoom/jpjzoom from a given lat/lon 
    1313   !!---------------------------------------------------------------------- 
    14    USE phycst                        ! Physical constants (and par_oce) 
    15    USE iom                           ! I/O library (iom_get) 
    16    USE in_out_manager                ! I/O manager (ctmp1) 
    17    USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting (mpp_init routine) 
     14   USE phycst         ! Physical constants (and par_oce) 
     15   USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting 
     16   ! 
     17   USE iom            ! I/O library (iom_get) 
     18   USE in_out_manager ! I/O manager (ctmp1) 
    1819   USE wrk_nemo                      ! Memory allocation 
    1920   USE timing                        ! Timing 
     
    2223   PRIVATE 
    2324 
    24    PUBLIC   dom_c1d                  ! Routine called in domcfg.F90 
    25  
    26    !!---------------------------------------------------------------------- 
    27    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     25   PUBLIC   dom_c1d   ! called in domcfg.F90 
     26 
     27   !!---------------------------------------------------------------------- 
     28   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    2829   !! $Id$  
    2930   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4344      !! ** Action  : Recalculate jpizoom, jpjzoom (indices of C1D zoom) 
    4445      !!---------------------------------------------------------------------- 
     46      REAL(wp), INTENT(in) ::  plat, plon    ! Column latitude &  longitude 
     47      ! 
     48      INTEGER  ::  ji, jj   ! Dummy loop indices 
     49      INTEGER  ::  inum     ! Coordinate file handle (case 0) 
     50      INTEGER  ::  ijeq     ! Index of equator T point (case 4) 
     51      INTEGER  ::  ios      ! Local integer output status for namelist read 
     52      INTEGER , DIMENSION(2) ::   iloc   ! Minloc returned indices 
     53      REAL(wp) ::  zlon                            ! Wraparound longitude 
     54      REAL(wp) ::  zti, ztj, zarg                  ! Local scalars 
     55      REAL(wp) ::  glam0, gphi0                    ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce 
     56      REAL(wp) ::  zlam1, zcos_alpha, ze1, ze1deg  ! Case 5 local scalars 
     57      REAL(wp) ::  zphi1, zsin_alpha, zim05, zjm05 !           
     58      REAL(wp) , POINTER, DIMENSION(:,:) ::  gphidta, glamdta, zdist ! Global lat/lon 
     59      !! 
    4560      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    4661         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
     
    5065         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
    5166         &             ppa2, ppkth2, ppacr2 
    52  
    53       INTEGER  ::  ji, jj                          ! Dummy loop indices 
    54       INTEGER  ::  inum                            ! Coordinate file handle (case 0) 
    55       INTEGER  ::  ijeq                            ! Index of equator T point (case 4) 
    56       INTEGER  ::  ios                             ! Local integer output status for namelist read 
    57  
    58       INTEGER , DIMENSION(2) ::   iloc             ! Minloc returned indices 
    59  
    60       REAL(wp), INTENT(in) ::  plat                ! Column latitude 
    61       REAL(wp), INTENT(in) ::  plon                ! Column longitude 
    62  
    63       REAL(wp) ::  zlon                            ! Wraparound longitude 
    64       REAL(wp) ::  zti, ztj, zarg                  ! Local scalars 
    65       REAL(wp) ::  glam0, gphi0                    ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce 
    66       REAL(wp) ::  zlam1, zcos_alpha, ze1, ze1deg  ! Case 5 local scalars 
    67       REAL(wp) ::  zphi1, zsin_alpha, zim05, zjm05 !          " 
    68  
    69       REAL(wp) , POINTER, DIMENSION(:,:) ::  gphidta, glamdta, zdist ! Global lat/lon 
    7067      !!---------------------------------------------------------------------- 
    7168 
     
    7471      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
    7572      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 ) 
    76 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
    77    
     73901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
    7874      ! 
    7975      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
    8076      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) 
    81 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    82  
    83       CALL wrk_alloc( jpidta, jpjdta, gphidta, glamdta, zdist ) 
    84  
     77902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     78 
     79      CALL wrk_alloc( jpidta,jpjdta,   gphidta, glamdta, zdist ) 
    8580 
    8681      ! ============================= ! 
     
    171166      END SELECT 
    172167 
    173  
    174168      ! ============================== ! 
    175169      !  Code from dom_ngb:            ! 
     
    192186      jpjzoom = iloc(2) + njmpp - 2  ! corner index of the zoom domain. 
    193187 
    194       CALL wrk_dealloc( jpidta, jpjdta, gphidta, glamdta, zdist ) 
     188      CALL wrk_dealloc( jpidta,jpjdta,  gphidta, glamdta, zdist ) 
    195189 
    196190      IF (lwp) THEN 
     
    202196         WRITE(numout,*) 
    203197      ENDIF 
    204  
     198      ! 
    205199      IF( nn_timing == 1 )   CALL timing_stop('dom_c1d') 
    206  
     200      ! 
    207201   END SUBROUTINE dom_c1d 
    208202 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90

    r5845 r6004  
    44   !! Ocean data  :  read ocean U & V current data from gridded data 
    55   !!====================================================================== 
    6    !! History :  3.5   ! 2013-08  (D. Calvert)  Original code 
    7    !!---------------------------------------------------------------------- 
    8  
    9    !!---------------------------------------------------------------------- 
    10    !!   dta_uvd_init   : read namelist and allocate data structures 
    11    !!   dta_uvd        : read and time-interpolate ocean U & V current data 
    12    !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE fldread         ! read input fields 
    16    USE in_out_manager  ! I/O manager 
    17    USE phycst          ! physical constants 
    18    USE lib_mpp         ! MPP library 
    19    USE wrk_nemo        ! Memory allocation 
    20    USE timing          ! Timing 
     6   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   dta_uvd_init  : read namelist and allocate data structures 
     11   !!   dta_uvd       : read and time-interpolate ocean U & V current data 
     12   !!---------------------------------------------------------------------- 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE phycst         ! physical constants 
     15   USE dom_oce        ! ocean space and time domain 
     16   ! 
     17   USE in_out_manager ! I/O manager 
     18   USE fldread        ! read input fields 
     19   USE lib_mpp        ! MPP library 
     20   USE wrk_nemo       ! Memory allocation 
     21   USE timing         ! Timing 
    2122 
    2223   IMPLICIT NONE 
     
    2627   PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90 
    2728 
    28    LOGICAL , PUBLIC ::   ln_uvd_init         ! Flag to initialise with U & V current data 
    29    LOGICAL , PUBLIC ::   ln_uvd_dyndmp       ! Flag for Newtonian damping toward U & V current data 
     29   LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data 
     30   LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data 
    3031 
    3132   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data) 
    3233 
    3334   !!---------------------------------------------------------------------- 
    34    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    3536   !! $Id$  
    3637   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4849      !!              - fld_fill data structure with namelist information 
    4950      !!---------------------------------------------------------------------- 
    50       LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp         ! force the initialization when dyndmp is used 
    51       ! 
    52       INTEGER ::   ierr0, ierr1, ierr2, ierr3              ! temporary integers 
    53       ! 
    54       CHARACTER(len=100)            ::   cn_dir            ! Root directory for location of files to be used 
    55       TYPE(FLD_N), DIMENSION(2)     ::   suv_i             ! Combined U & V namelist information 
    56       TYPE(FLD_N)                   ::   sn_ucur, sn_vcur  ! U & V data namelist information 
     51      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp   ! force the initialization when dyndmp is used 
     52      ! 
     53      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3     ! local integers 
     54      CHARACTER(len=100)        ::   cn_dir            ! Root directory for location of files to be used 
     55      TYPE(FLD_N), DIMENSION(2) ::   suv_i             ! Combined U & V namelist information 
     56      TYPE(FLD_N)               ::   sn_ucur, sn_vcur  ! U & V data namelist information 
    5757      !! 
    5858      NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur 
    59       INTEGER  ::   ios 
    60       !!---------------------------------------------------------------------- 
    61       ! 
    62       IF( nn_timing == 1 )  CALL timing_start('dta_uvd_init') 
    63       ! 
    64       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
     59      !!---------------------------------------------------------------------- 
     60      ! 
     61      IF( nn_timing == 1 )   CALL timing_start('dta_uvd_init') 
     62      ! 
     63      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0 
    6564 
    6665      REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist :  
    6766      READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901) 
    68 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 
    69  
     67901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 
     68      ! 
    7069      REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run 
    7170      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 ) 
    72 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 
     71902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 
    7372      IF(lwm) WRITE ( numond, namc1d_uvd ) 
    7473 
     
    147146      !!---------------------------------------------------------------------- 
    148147      ! 
    149       IF( nn_timing == 1 )  CALL timing_start('dta_uvd') 
     148      IF( nn_timing == 1 )   CALL timing_start('dta_uvd') 
    150149      ! 
    151150      CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==! 
    152       ! 
    153       ! 
    154       !                                   !==   ORCA_R2 configuration and U & V current damping   ==!  
    155       IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_uvd_dyndmp ) THEN    ! some hand made alterations 
    156          !!! EMPTY- to be added for running in 3D context !!! 
    157       ENDIF 
    158151      ! 
    159152      puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask 
     
    162155      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    163156         ! 
    164          CALL wrk_alloc( jpk, zup, zvp ) 
     157         CALL wrk_alloc( jpk,   zup, zvp ) 
    165158         ! 
    166159         IF( kt == nit000 .AND. lwp )THEN 
     
    198191         END DO 
    199192         !  
    200          CALL wrk_dealloc( jpk, zup, zvp ) 
     193         CALL wrk_dealloc( jpk,   zup, zvp ) 
    201194         !  
    202195      ELSE                                !==   z- or zps- coordinate   ==! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90

    r5215 r6004  
    1111   !!   'key_c1d'                                          1D Configuration 
    1212   !!---------------------------------------------------------------------- 
    13    !!   cor_c1d      : Coriolis factor at T-point (1D configuration) 
    14    !!   dyn_cor_c1d  : vorticity trend due to Coriolis at T-point 
     13   !!   cor_c1d       : Coriolis factor at T-point (1D configuration) 
     14   !!   dyn_cor_c1d   : vorticity trend due to Coriolis at T-point 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce               ! ocean dynamics and tracers 
    17    USE dom_oce           ! ocean space and time domain 
    18    USE phycst            ! physical constants 
    19    USE in_out_manager    ! I/O manager 
    20    USE prtctl            ! Print control 
     16   USE oce            ! ocean dynamics and tracers 
     17   USE dom_oce        ! ocean space and time domain 
     18   USE phycst         ! physical constants 
     19   ! 
     20   USE in_out_manager ! I/O manager 
     21   USE prtctl         ! Print control 
    2122 
    2223   IMPLICIT NONE 
    2324   PRIVATE 
    2425 
    25    PUBLIC   cor_c1d      ! routine called by OPA.F90 
    26    PUBLIC   dyn_cor_c1d  ! routine called by step1d.F90 
     26   PUBLIC   cor_c1d      ! called by nemogcm.F90 
     27   PUBLIC   dyn_cor_c1d  ! called by step1d.F90 
    2728 
    2829   !! * Substitutions 
    2930#  include "vectopt_loop_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    31    !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
     32   !! NEMO/C1D 3.7 , NEMO Consortium (2015) 
    3233   !! $Id$  
    3334   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4142      !! ** Purpose : set the Coriolis factor at T-point 
    4243      !!---------------------------------------------------------------------- 
    43       REAL(wp) ::   zphi0, zbeta, zf0         !  temporary scalars 
     44      REAL(wp) ::   zphi0, zbeta, zf0   ! local scalars 
    4445      !!---------------------------------------------------------------------- 
    4546 
     
    8788      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    8889      !! 
    89       INTEGER ::   ji, jj, jk         ! dummy loop indices 
     90      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    9091      !!---------------------------------------------------------------------- 
    9192      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r5845 r6004  
    2323   USE dtauvd         ! data: U & V current 
    2424   USE zdfmxl         ! vertical physics: mixed layer depth 
     25   ! 
    2526   USE in_out_manager ! I/O manager 
    2627   USE lib_mpp        ! MPP library 
     
    3637   PUBLIC   dyn_dmp      ! routine called by step_c1d.F90 
    3738 
    38    LOGICAL, PUBLIC ::   ln_dyndmp           ! Flag for Newtonian damping 
    39  
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  utrdmp    ! damping U current trend (m/s2) 
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  vtrdmp    ! damping V current trend (m/s2) 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  resto_uv  ! restoring coeff. on U & V current 
     39   LOGICAL, PUBLIC ::   ln_dyndmp   !: Flag for Newtonian damping 
     40 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  utrdmp    !: damping U current trend (m/s2) 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  vtrdmp    !: damping V current trend (m/s2) 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  resto_uv  !: restoring coeff. on U & V current 
    4344 
    4445   !! * Substitutions 
    4546#  include "vectopt_loop_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    47    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     48   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    4849   !! $Id$  
    4950   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    7475      !!              - calculate damping coefficient 
    7576      !!---------------------------------------------------------------------- 
     77      INTEGER ::   ios, imask   ! local integers 
     78      !! 
    7679      NAMELIST/namc1d_dyndmp/ ln_dyndmp 
    77       INTEGER :: ios 
    78       INTEGER :: imask 
    79       !!---------------------------------------------------------------------- 
    80  
     80      !!---------------------------------------------------------------------- 
     81      ! 
    8182      REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist :  
    8283      READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901) 
    83 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp ) 
    84  
     84901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp ) 
     85      ! 
    8586      REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run 
    8687      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 ) 
    87 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp ) 
     88902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp ) 
    8889      IF(lwm) WRITE ( numond, namc1d_dyndmp ) 
    89  
     90      ! 
    9091      IF(lwp) THEN                           ! control print 
    9192         WRITE(numout,*) 
     
    100101         WRITE(numout,*) 
    101102      ENDIF 
    102  
     103      ! 
    103104      IF( ln_dyndmp ) THEN 
    104105         !                                   !==   allocate the data arrays   ==! 
     
    149150      !! ** Action  : - (ua,va)   momentum trends updated with the damping trend 
    150151      !!---------------------------------------------------------------------- 
    151       INTEGER, INTENT(in) ::   kt                        ! ocean time-step index 
    152       !! 
    153       INTEGER  ::   ji, jj, jk                           ! dummy loop indices 
    154       REAL(wp) ::   zua, zva                             ! local scalars 
    155       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zuv_dta  ! Read in data  
     152      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     153      !! 
     154      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     155      REAL(wp) ::   zua, zva     ! local scalars 
     156      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuv_dta   ! Read in data  
    156157      !!---------------------------------------------------------------------- 
    157158      ! 
    158159      IF( nn_timing == 1 )  CALL timing_start( 'dyn_dmp' ) 
    159160      ! 
    160       CALL wrk_alloc( jpi, jpj, jpk, 2,  zuv_dta ) 
     161      CALL wrk_alloc( jpi,jpj,jpk,2,   zuv_dta ) 
    161162      ! 
    162163      !                           !==   read and interpolate U & V current data at kt   ==! 
     
    220221      END SELECT 
    221222      ! 
    222 !!gm      !                           ! Trend diagnostic 
    223 !!gm      IF( l_trddyn )   CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt ) 
    224       ! 
    225223      !                           ! Control print 
    226224      IF( ln_ctl   )   CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp  - Ua: ', mask1=umask,   & 
    227225         &                           tab3d_2=va(:,:,:), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    228226      ! 
    229       CALL wrk_dealloc( jpi, jpj, jpk, 2,  zuv_dta ) 
     227      CALL wrk_dealloc( jpi,jpj,jpk,2,   zuv_dta ) 
    230228      ! 
    231229      IF( nn_timing == 1 )  CALL timing_stop( 'dyn_dmp') 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r5845 r6004  
    1818#endif 
    1919   USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     ) 
    20    USE dynnxt_c1d      ! time-stepping                    (dyn_nxt routine) 
     20   USE dynnxt          ! time-stepping                    (dyn_nxt routine) 
    2121   USE dyndmp          ! U & V momentum damping           (dyn_dmp routine) 
    2222   USE restart         ! restart  
     
    3030#  include "zdfddm_substitute.h90" 
    3131   !!---------------------------------------------------------------------- 
    32    !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
     32   !! NEMO/C1D 3.7 , NEMO Consortium (2015) 
    3333   !! $Id$ 
    3434   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    5454      !!---------------------------------------------------------------------- 
    5555      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index 
     56      ! 
    5657      INTEGER ::   jk       ! dummy loop indice 
    5758      INTEGER ::   indic    ! error indicator if < 0 
     
    138139                        CALL dyn_cor_c1d( kstp )   ! vorticity term including Coriolis 
    139140                        CALL dyn_zdf    ( kstp )   ! vertical diffusion 
    140                         CALL dyn_nxt_c1d( kstp )   ! lateral velocity at next time step 
     141                        CALL dyn_nxt    ( kstp )   ! lateral velocity at next time step 
    141142 
    142143      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r5845 r6004  
    354354    
    355355   !!====================================================================== 
    356  
    357356END MODULE crs 
    358357 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5845 r6004  
    342342      !! History.     4 Jun.  Write for WGT and scale factors only 
    343343      !!---------------------------------------------------------------- 
    344       !!  
    345       !!  Arguments 
    346       CHARACTER(len=1),                         INTENT(in)  :: cd_type  ! grid type U,V  
    347       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_mask  ! Parent grid U,V mask 
    348       REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1) 
    349       REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2) 
    350       REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (e3u, e3v) 
    351  
    352       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity  
    353       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity  
    354  
    355       !! Local variables 
    356       REAL(wp)                                :: zdAm 
    357       INTEGER                                 :: ji, jj, jk , ii, ij, je_2 
    358  
    359       REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol, zmask       
     344      CHARACTER(len=1),                         INTENT(in   ) ::   cd_type    ! grid type U,V  
     345      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_mask     ! Parent grid U,V mask 
     346      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e1       ! Parent grid U,V scale factors (e1) 
     347      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e2       ! Parent grid U,V scale factors (e2) 
     348      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_e3       ! Parent grid vertical level thickness (e3u, e3v) 
     349      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld1_crs ! Coarse grid box 3D quantity  
     350      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld2_crs ! Coarse grid box 3D quantity  
     351      ! 
     352      INTEGER  ::   ji, jj, jk , ii, ij, je_2 
     353      REAL(wp) ::   zdAm 
     354      REAL(wp), DIMENSION(:,:,:), POINTER ::   zvol, zmask       
    360355      !!----------------------------------------------------------------   
    361     
    362       CALL wrk_alloc( jpi, jpj, jpk, zvol, zmask ) 
    363  
    364       p_fld1_crs(:,:,:) = 0.0 
    365       p_fld2_crs(:,:,:) = 0.0 
     356      ! 
     357      CALL wrk_alloc( jpi,jpj,jpk,  zvol, zmask ) 
     358      ! 
     359      p_fld1_crs(:,:,:) = 0._wp 
     360      p_fld2_crs(:,:,:) = 0._wp 
    366361 
    367362      DO jk = 1, jpk 
    368363         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
    369       ENDDO 
    370  
    371       zmask(:,:,:) = 0.0 
     364      END DO 
     365 
     366      zmask(:,:,:) = 0._wp 
    372367      IF( cd_type == 'W' ) THEN 
    373368         zmask(:,:,1) = p_mask(:,:,1)  
     
    478473      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    479474      !!---------------------------------------------------------------- 
    480       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    481       CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
     475      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld      ! T, U, V or W on parent grid 
     476      CHARACTER(len=3),                         INTENT(in)           :: cd_op      ! Operation SUM, MAX or MIN 
    482477      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V  
    483       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
    484       REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2) 
    485       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (e3u, e3v) 
     478      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask     ! Parent grid T,U,V mask 
     479      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12      ! Parent grid T,U,V scale factors (e1 or e2) 
     480      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3       ! Parent grid vertical level thickness (e3u, e3v) 
    486481      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    487       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V maska 
    488       REAL(wp),                                 INTENT(in)           :: psgn    ! sign  
    489       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out)        :: p_fld_crs ! Coarse grid box 3D quantity  
    490       ! 
    491       INTEGER  :: ji, jj, jk  
    492       INTEGER  :: ii, ij, ijie, ijje, je_2 
    493       REAL(wp) :: zflcrs, zsfcrs    
    494       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask   
     482      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska 
     483      REAL(wp),                                 INTENT(in)           :: psgn       ! sign  
     484      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out)        :: p_fld_crs  ! Coarse grid box 3D quantity  
     485      ! 
     486      INTEGER  ::   ji, jj, jk  
     487      INTEGER  ::   ii, ij, ijie, ijje, je_2 
     488      REAL(wp) ::   zflcrs, zsfcrs    
     489      REAL(wp), DIMENSION(:,:,:), POINTER ::   zsurf, zsurfmsk, zmask   
    495490      !!----------------------------------------------------------------   
    496491      ! 
     
    498493      ! 
    499494      SELECT CASE ( cd_op ) 
    500        
    501          CASE ( 'VOL' ) 
    502        
    503             CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    504           
    505             SELECT CASE ( cd_type ) 
    506              
    507                CASE( 'T', 'W' ) 
    508                   IF( cd_type == 'T' ) THEN 
     495      ! 
     496      CASE ( 'VOL' ) 
     497         ! 
     498         CALL wrk_alloc( jpi,jpj,jpk,  zsurf, zsurfmsk ) 
     499         !    
     500         SELECT CASE ( cd_type ) 
     501         !    
     502         CASE( 'T', 'W' ) 
     503               IF( cd_type == 'T' ) THEN 
    509504                     DO jk = 1, jpk 
    510505                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
     
    11401135      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights. 
    11411136      !!---------------------------------------------------------------- 
    1142       !!  
    1143       !!  Arguments 
    11441137      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    11451138      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
     
    11511144      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask 
    11521145      REAL(wp),                                 INTENT(in)           :: psgn    
    1153  
    11541146      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    1155  
    1156       !! Local variables 
     1147      ! 
    11571148      INTEGER  :: ji, jj, jk                 ! dummy loop indices 
    11581149      INTEGER  :: ijie, ijje, ii, ij, je_2 
    11591150      REAL(wp) :: zflcrs, zsfcrs    
    11601151      REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk    
    1161  
    11621152      !!----------------------------------------------------------------   
    1163     
    1164       p_fld_crs(:,:) = 0.0 
    1165  
     1153      ! 
     1154      p_fld_crs(:,:) = 0._wp 
     1155      ! 
    11661156      SELECT CASE ( cd_op ) 
    11671157       
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    r5845 r6004  
    11MODULE crslbclnk 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  crslbclnk  *** 
     
    87   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code 
    98   !!---------------------------------------------------------------------- 
     9   USE par_kind, ONLY: wp 
    1010   USE dom_oce 
    1111   USE crs 
     12   ! 
    1213   USE lbclnk 
    13    USE par_kind, ONLY: wp 
    1414   USE in_out_manager 
    1515    
     
    3737      !!                Upon exiting, switch back to full domain indices. 
    3838      !!---------------------------------------------------------------------- 
    39       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type 
    40       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    41  
    42       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied 
    43       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    44       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     39      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1 ! grid type 
     40      REAL(wp)                                , INTENT(in   ) ::   psgn     ! control of the sign 
     41      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1    ! 3D array on which the lbc is applied 
     42      REAL(wp)                      , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo 
     43      CHARACTER(len=3)              , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing) 
    4544      ! 
    46       LOGICAL                                                   ::   ll_grid_crs 
    47       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
     45      LOGICAL  ::   ll_grid_crs 
     46      REAL(wp) ::   zval   ! valeur sur les halo 
    4847      !!---------------------------------------------------------------------- 
    49        
     48      ! 
    5049      ll_grid_crs = ( jpi == jpi_crs ) 
    51        
     50      ! 
    5251      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    53       ELSE                      ;  zval = 0.0 
     52      ELSE                      ;  zval = 0._wp 
    5453      ENDIF 
    55        
    56       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    57  
     54      ! 
     55      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     56      ! 
    5857      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
    5958      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  ) 
    6059      ENDIF 
    61  
    62       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    63  
     60      ! 
     61      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     62      ! 
    6463   END SUBROUTINE crs_lbc_lnk_3d 
     64    
    6565    
    6666   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
     
    7474      !!                Upon exiting, switch back to full domain indices. 
    7575      !!---------------------------------------------------------------------- 
    76       !! Arguments 
    77       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1,cd_type2 ! grid type 
    78       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    79  
    80       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1,pt3d2 ! 3D array on which the lbc is applied 
    81        
    82       !! local vairables 
    83       LOGICAL                                                   ::   ll_grid_crs 
     76      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type 
     77      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign 
     78      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied 
     79      ! 
     80      LOGICAL ::   ll_grid_crs 
    8481      !!---------------------------------------------------------------------- 
    85        
     82      ! 
    8683      ll_grid_crs = ( jpi == jpi_crs ) 
    87        
    88       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    89  
     84      ! 
     85      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     86      ! 
    9087      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  ) 
    91  
    92       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    93  
     88      ! 
     89      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     90      ! 
    9491   END SUBROUTINE crs_lbc_lnk_3d_gather 
    9592 
     
    106103      !!                Upon exiting, switch back to full domain indices. 
    107104      !!---------------------------------------------------------------------- 
    108       !! Arguments 
    109       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type 
    110       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    111  
    112       REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied 
    113       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    114       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing) 
    115       !! local variables 
    116        
    117       LOGICAL                                                   ::   ll_grid_crs 
    118       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    119  
     105      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type 
     106      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign 
     107      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied 
     108      REAL(wp)                  , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo 
     109      CHARACTER(len=3)          , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing) 
     110      !       
     111      LOGICAL  ::   ll_grid_crs 
     112      REAL(wp) ::   zval     ! valeur sur les halo 
    120113      !!---------------------------------------------------------------------- 
    121        
     114      ! 
    122115      ll_grid_crs = ( jpi == jpi_crs ) 
    123        
     116      ! 
    124117      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    125       ELSE                      ;  zval = 0.0 
     118      ELSE                      ;  zval = 0._wp 
    126119      ENDIF 
    127        
    128       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    129  
     120      ! 
     121      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     122      ! 
    130123      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
    131124      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  ) 
    132125      ENDIF 
    133  
    134       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    135  
     126      ! 
     127      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     128      ! 
    136129   END SUBROUTINE crs_lbc_lnk_2d 
    137130 
    138  
     131   !!====================================================================== 
    139132END MODULE crslbclnk 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r5883 r6004  
    104104      END DO 
    105105      IF( ln_linssh ) THEN 
    106          IF ( ln_isfcav ) THEN 
     106         IF( ln_isfcav ) THEN 
    107107            DO ji=1,jpi 
    108108               DO jj=1,jpj 
     
    167167      END DO 
    168168      IF( ln_linssh ) THEN 
    169          IF ( ln_isfcav ) THEN 
     169         IF( ln_isfcav ) THEN 
    170170            DO ji=1,jpi 
    171171               DO jj=1,jpj 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r5586 r6004  
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE phycst 
    16    USE dynspg_oce 
    17    USE dynspg_ts 
    1816   USE daymod 
    1917   USE tide_mod 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r5866 r6004  
    110110      ! 
    111111      IF( ln_linssh ) THEN 
    112          IF ( ln_isfcav ) THEN 
     112         IF( ln_isfcav ) THEN 
    113113            DO ji=1,jpi 
    114114               DO jj=1,jpj 
    115115                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 
    116116                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 
    117                ENDDO 
    118             ENDDO 
     117               END DO 
     118            END DO 
    119119         ELSE 
    120120            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 
     
    146146      ! heat & salt content variation (associated with ssh) 
    147147      IF( ln_linssh ) THEN 
    148          IF ( ln_isfcav ) THEN 
     148         IF( ln_isfcav ) THEN 
    149149            DO ji = 1, jpi 
    150150               DO jj = 1, jpj 
     
    163163      DO jk = 1, jpkm1 
    164164         ! volume variation (calculated with scale factors) 
    165          zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 
     165         zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk)            & 
    166166            &                           * ( e3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
    167167         ! heat content variation 
    168          zdiff_hc = zdiff_hc + glob_sum(  surf(:,:) * tmask(:,:,jk) &  
     168         zdiff_hc = zdiff_hc + glob_sum(  surf(:,:) * tmask(:,:,jk)                                   &  
    169169            &                           * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 
    170170         ! salt content variation 
    171          zdiff_sc = zdiff_sc + glob_sum(  surf(:,:) * tmask(:,:,jk)   & 
     171         zdiff_sc = zdiff_sc + glob_sum(  surf(:,:) * tmask(:,:,jk)                                   & 
    172172            &                           * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 
    173       ENDDO 
     173      END DO 
    174174 
    175175      ! Substract forcing from heat content, salt content and volume variations 
     
    199199!!gm end 
    200200 
    201       IF( .NOT.ln_linssh ) THEN 
    202         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
    203         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    variation (psu) 
    204         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content variation (1.e20 J)  
    205         CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content variation (psu*km3) 
    206         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh variation (km3)   
    207         CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t variation (km3)   
    208         CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    209         CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
    210         CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
    211       ELSE 
     201      IF( ln_linssh ) THEN 
    212202        CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content variation (C)  
    213203        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu) 
     
    220210        CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C) 
    221211        CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu) 
     212      ELSE 
     213        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
     214        CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    variation (psu) 
     215        CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content variation (1.e20 J)  
     216        CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content variation (psu*km3) 
     217        CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh variation (km3)   
     218        CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t variation (km3)   
     219        CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
     220        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
     221        CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
    222222      ENDIF 
    223223      ! 
    224224      IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' ) 
    225  
     225      ! 
    226226      CALL wrk_dealloc( jpi,jpj,   z2d0, z2d1 ) 
    227  
     227      ! 
    228228      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb') 
    229229      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r5866 r6004  
    5252      !!--------------------------------------------------------------------- 
    5353      ! 
    54       ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc) 
     54      ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc ) 
    5555      ! 
    5656      IF( lk_mpp           )   CALL mpp_sum ( dia_hth_alloc ) 
     
    108108      IF( kt == nit000 ) THEN 
    109109         !                                      ! allocate dia_hth array 
    110          IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 
    111  
    112          IF(.not. ALLOCATED(ik20))THEN 
     110         IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' ) 
     111 
     112         IF(.NOT. ALLOCATED(ik20) ) THEN 
    113113            ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 
    114114               &      zabs2(jpi,jpj),   & 
     
    311311      END DO 
    312312      ! surface boundary condition 
    313       IF( .NOT.ln_linssh ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                    
    314       ELSE                        ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
     313      IF( ln_linssh ) THEN   ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
     314      ELSE                   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                    
    315315      ENDIF 
    316316      ! integration down to ilevel 
     
    323323      DO jj = 1, jpj 
    324324         DO ji = 1, jpi 
    325             htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) )  & 
    326                                                                    * tmask(ji,jj,ilevel+1) 
     325            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem)                  & 
     326               &                      * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
    327327         END DO 
    328328      END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r5845 r6004  
    120120                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 
    121121                     zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 
    122                   ENDDO 
    123                ENDDO 
    124             ENDDO 
     122                  END DO 
     123               END DO 
     124            END DO 
    125125            DO jn = 1, nptr 
    126126               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5866 r6004  
    3131   USE ldftra          ! lateral physics: eddy diffusivity coef. 
    3232   USE ldfdyn          ! lateral physics: eddy viscosity   coef. 
    33    USE sol_oce         ! solver variables 
    3433   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3534   USE sbc_ice         ! Surface boundary condition: ice fields 
     
    4847   USE iom 
    4948   USE ioipsl 
    50    USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities      
    5149 
    5250#if defined key_lim2 
     
    207205         CALL iom_put( "sbu", z2d )                ! bottom i-current 
    208206      ENDIF 
    209 #if defined key_dynspg_ts 
    210       CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current 
    211 #else 
    212       CALL iom_put(  "ubar", un_b(:,:)        )    ! barotropic i-current 
    213 #endif 
    214207       
    215208      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current 
     
    224217         CALL iom_put( "sbv", z2d )                ! bottom j-current 
    225218      ENDIF 
    226 #if defined key_dynspg_ts 
    227       CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic j-current 
    228 #else 
    229       CALL iom_put(  "vbar", vn_b(:,:)        )    ! barotropic j-current 
    230 #endif 
    231219 
    232220      CALL iom_put( "woce", wn )                   ! vertical velocity 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r5563 r6004  
    2626   !! 
    2727   !!---------------------------------------------------------------------- 
    28    USE dom_oce         ! ocean space and time domain 
    29    USE phycst          ! physical constants 
    30    USE in_out_manager  ! I/O manager 
    31    USE iom             ! 
    32    USE ioipsl, ONLY :   ymds2ju   ! for calendar 
    33    USE prtctl          ! Print control 
    34    USE trc_oce, ONLY : lk_offline ! offline flag 
    35    USE timing          ! Timing 
    36    USE restart         ! restart 
     28   USE dom_oce        ! ocean space and time domain 
     29   USE phycst         ! physical constants 
     30   USE in_out_manager ! I/O manager 
     31   USE iom            ! 
     32   USE ioipsl  , ONLY :   ymds2ju   ! for calendar 
     33   USE prtctl         ! Print control 
     34   USE trc_oce , ONLY : lk_offline ! offline flag 
     35   USE timing         ! Timing 
     36   USE restart        ! restart 
    3737 
    3838   IMPLICIT NONE 
     
    4343   PUBLIC   day_mth    ! Needed by TAM 
    4444 
    45    INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05 ! (PUBLIC for TAM) 
     45   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM) 
    4646 
    4747   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5866 r6004  
    4646   LOGICAL , PUBLIC ::   ln_crs          !: Apply grid coarsening to dynamical model output or online passive tracers 
    4747 
     48   !! Free surface parameters 
     49   !! ======================= 
     50   LOGICAL , PUBLIC :: ln_dynspg_exp     !: Explicit free surface flag 
     51   LOGICAL , PUBLIC :: ln_dynspg_ts      !: Split-Explicit free surface flag 
     52 
    4853   !! Time splitting parameters 
    4954   !! ========================= 
    5055   LOGICAL,  PUBLIC :: ln_bt_fw          !: Forward integration of barotropic sub-stepping 
    5156   LOGICAL,  PUBLIC :: ln_bt_av          !: Time averaging of barotropic variables 
    52    LOGICAL,  PUBLIC :: ln_bt_nn_auto     !: Set number of barotropic iterations automatically 
     57   LOGICAL,  PUBLIC :: ln_bt_auto        !: Set number of barotropic iterations automatically 
    5358   INTEGER,  PUBLIC :: nn_bt_flt         !: Filter choice 
    5459   INTEGER,  PUBLIC :: nn_baro           !: Number of barotropic iterations during one baroclinic step (rdt) 
    55    REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_nn_auto=T) 
     60   REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_auto=T) 
    5661 
    5762   !! Horizontal grid parameters for domhgr 
    5863   !! ===================================== 
    59    INTEGER       ::   jphgr_msh        !: type of horizontal mesh 
     64   INTEGER       ::   jphgr_msh          !: type of horizontal mesh 
    6065   !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc 
    6166   !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing 
     
    6469   !                                       !  = 4 Mercator grid with T/U point at the equator 
    6570 
    66    REAL(wp)      ::   ppglam0              !: longitude of first raw and column T-point (jphgr_msh = 1) 
    67    REAL(wp)      ::   ppgphi0              !: latitude  of first raw and column T-point (jphgr_msh = 1) 
     71   REAL(wp)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1) 
     72   REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1) 
    6873   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3) 
    69    REAL(wp)      ::   ppe1_deg             !: zonal      grid-spacing (degrees) 
    70    REAL(wp)      ::   ppe2_deg             !: meridional grid-spacing (degrees) 
    71    REAL(wp)      ::   ppe1_m               !: zonal      grid-spacing (degrees) 
    72    REAL(wp)      ::   ppe2_m               !: meridional grid-spacing (degrees) 
     74   REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees) 
     75   REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees) 
     76   REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees) 
     77   REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees) 
    7378 
    7479   !! Vertical grid parameter for domzgr 
    7580   !! ================================== 
    76    REAL(wp)      ::   ppsur                !: ORCA r4, r2 and r05 coefficients 
    77    REAL(wp)      ::   ppa0                 !: (default coefficients) 
    78    REAL(wp)      ::   ppa1                 !: 
    79    REAL(wp)      ::   ppkth                !: 
    80    REAL(wp)      ::   ppacr                !: 
     81   REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients 
     82   REAL(wp)      ::   ppa0               !: (default coefficients) 
     83   REAL(wp)      ::   ppa1               !: 
     84   REAL(wp)      ::   ppkth              !: 
     85   REAL(wp)      ::   ppacr              !: 
    8186   ! 
    8287   !  If both ppa0 ppa1 and ppsur are specified to 0, then 
    8388   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 
    84    REAL(wp)      ::   ppdzmin              !: Minimum vertical spacing 
    85    REAL(wp)      ::   pphmax               !: Maximum depth 
     89   REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing 
     90   REAL(wp)      ::   pphmax             !: Maximum depth 
    8691   ! 
    87    LOGICAL       ::   ldbletanh            !: Use/do not use double tanf function for vertical coordinates 
    88    REAL(wp)      ::   ppa2                 !: Double tanh function parameters 
    89    REAL(wp)      ::   ppkth2               !: 
    90    REAL(wp)      ::   ppacr2               !: 
     92   LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates 
     93   REAL(wp)      ::   ppa2               !: Double tanh function parameters 
     94   REAL(wp)      ::   ppkth2             !: 
     95   REAL(wp)      ::   ppacr2             !: 
    9196 
    9297   !                                    !! old non-DOCTOR names still used in the model 
     
    102107   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step 
    103108 
    104    !                                                  !!! associated variables 
    105    INTEGER , PUBLIC                 ::   neuler        !: restart euler forward option (0=Euler) 
    106    REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp) 
     109   !                                   !!! associated variables 
     110   INTEGER , PUBLIC ::   neuler          !: restart euler forward option (0=Euler) 
     111   REAL(wp), PUBLIC ::   atfp1           !: asselin time filter coeff. (atfp1= 1-2*atfp) 
     112    
    107113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttra  !: vertical profile of tracer time step 
    108114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 
     
    211217   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points 
    212218 
     219!!gm  This should be removed from here....  ==>>> only used in domzgr at initialization phase 
    213220   !! s-coordinate and hybrid z-s-coordinate 
    214221   !! =----------------======--------------- 
     
    224231   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m) 
    225232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio 
     233!!gm end 
    226234 
    227235   !!---------------------------------------------------------------------- 
     
    229237   !! --------------------------------------------------------------------- 
    230238   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1) 
    231    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level 
    232    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level 
    233    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy                              !: ocean depth (meters) 
     239   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: vertical index of the bottom last T-, U- & V ocean level 
     240   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters) 
    234241   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask 
    235    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask                              !: land/ocean mask of barotropic stream function 
    236242 
    237243   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF) 
     
    364370      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      & 
    365371         &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    366          &     bmask  (jpi,jpj) ,                                                       & 
    367372         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
    368373 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5883 r6004  
    1313   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration 
    1414   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 
    15    !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default 
     15   !!            3.7  ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1616   !!---------------------------------------------------------------------- 
    1717    
     
    7070      !!              - 1D configuration, move Coriolis, u and v at T-point 
    7171      !!---------------------------------------------------------------------- 
    72       INTEGER ::   jk          ! dummy loop argument 
     72      INTEGER ::   jk          ! dummy loop indices 
    7373      INTEGER ::   iconf = 0   ! local integers 
    74       REAL(wp), POINTER, DIMENSION(:,:)   ::  z1_hu_0, z1_hv_0 
     74      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0 
    7575      !!---------------------------------------------------------------------- 
    7676      ! 
     
    427427      INTEGER  ::   ji, jj, jk  
    428428      REAL(wp) ::   zrxmax 
    429       REAL(wp), DIMENSION(4) :: zr1 
     429      REAL(wp), DIMENSION(4) ::   zr1 
    430430      !!---------------------------------------------------------------------- 
    431431      rx1(:,:) = 0._wp 
     
    444444                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               & 
    445445                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk) 
    446                zr1(3) =ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               & 
     446               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               & 
    447447                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             & 
    448448                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               & 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5845 r6004  
    391391         ! 
    392392#if defined key_agrif 
    393          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    394             IF( .NOT. Agrif_Root() ) THEN 
    395               zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2 )*Agrif_Parent(ppe2_m)   & 
    396                &              / (ra * rad)         ! CAUTIOn : split in 2 lignes for AGRIF 
     393         IF( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN       ! for EEL6 configuration only 
     394            IF( .NOT.Agrif_Root() ) THEN 
     395              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    397396            ENDIF 
    398397         ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r5845 r6004  
    77   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon) 
    88   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays 
    9    !!             -   ! 1996-05  (G. Madec)  mask computed from tmask and sup- 
    10    !!                 !                      pression of the double computation of bmask 
     9   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask 
    1110   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F 
    1211   !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask 
     
    2524   USE oce             ! ocean dynamics and tracers 
    2625   USE dom_oce         ! ocean space and time domain 
     26   ! 
    2727   USE in_out_manager  ! I/O manager 
    2828   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    29    USE lib_mpp 
    30    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
     29   USE lib_mpp         ! 
    3130   USE wrk_nemo        ! Memory allocation 
    3231   USE timing          ! Timing 
     
    3534   PRIVATE 
    3635 
    37    PUBLIC   dom_msk         ! routine called by inidom.F90 
     36   PUBLIC   dom_msk    ! routine called by inidom.F90 
    3837 
    3938   !                            !!* Namelist namlbc : lateral boundary condition * 
     
    9089      !! 
    9190      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays 
    92       !!      are defined with the proper value at lateral domain boundaries, 
    93       !!      but bmask. indeed, bmask defined the domain over which the 
    94       !!      barotropic stream function is computed. this domain cannot 
    95       !!      contain identical columns because the matrix associated with 
    96       !!      the barotropic stream function equation is then no more inverti- 
    97       !!      ble. therefore bmask is set to 0 along lateral domain boundaries 
    98       !!      even IF nperio is not zero. 
     91      !!      are defined with the proper value at lateral domain boundaries. 
    9992      !! 
    10093      !!      In case of open boundaries (lk_bdy=T): 
    10194      !!        - tmask is set to 1 on the points to be computed bay the open 
    10295      !!          boundaries routines. 
    103       !!        - bmask is  set to 0 on the open boundaries. 
    10496      !! 
    10597      !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.) 
     
    108100      !!               fmask    : land/ocean mask at f-point (=0. or 1.) 
    109101      !!                          =rn_shlat along lateral boundaries 
    110       !!               bmask    : land/ocean mask at barotropic stream 
    111       !!                          function point (=0. or 1.) and set to 0 along lateral boundaries 
    112102      !!               tmask_i  : interior ocean mask 
    113103      !!---------------------------------------------------------------------- 
     
    255245      END DO 
    256246 
    257       ! 4. ocean/land mask for the elliptic equation 
    258       ! -------------------------------------------- 
    259       bmask(:,:) = ssmask(:,:)       ! elliptic equation is written at t-point 
    260       ! 
    261       !                               ! Boundary conditions 
    262       !                                    ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi 
    263       IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 
    264          bmask( 1 ,:) = 0._wp 
    265          bmask(jpi,:) = 0._wp 
    266       ENDIF 
    267       IF( nperio == 2 ) THEN               ! south symmetric :  bmask must be set to 0. on row 1 
    268          bmask(:, 1 ) = 0._wp 
    269       ENDIF 
    270       !                                    ! north fold :  
    271       IF( nperio == 3 .OR. nperio == 4 ) THEN   ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row 
    272          DO ji = 1, jpi                       
    273             ii = ji + nimpp - 1 
    274             bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii) 
    275             bmask(ji,jpj  ) = 0._wp 
    276          END DO 
    277       ENDIF 
    278       IF( nperio == 5 .OR. nperio == 6 ) THEN   ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 
    279          bmask(:,jpj) = 0._wp 
    280       ENDIF 
    281       ! 
    282       IF( lk_mpp ) THEN                    ! mpp specificities 
    283          !                                      ! bmask is set to zero on the overlap region 
    284          IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0._wp 
    285          IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0._wp 
    286          IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0._wp 
    287          IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0._wp 
    288          ! 
    289          IF( npolj == 3 .OR. npolj == 4 ) THEN  ! north fold : bmask must be set to 0. on rows jpj-1 and jpj 
    290             DO ji = 1, nlci 
    291                ii = ji + nimpp - 1 
    292                bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii) 
    293                bmask(ji,nlcj  ) = 0._wp 
    294             END DO 
    295          ENDIF 
    296          IF( npolj == 5 .OR. npolj == 6 ) THEN  ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 
    297             DO ji = 1, nlci 
    298                bmask(ji,nlcj  ) = 0._wp 
    299             END DO 
    300          ENDIF 
    301       ENDIF 
    302  
    303247      ! Lateral boundary conditions on velocity (modify fmask) 
    304248      ! ---------------------------------------      
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5883 r6004  
    6464#  include "vectopt_loop_substitute.h90" 
    6565   !!---------------------------------------------------------------------- 
    66    !! NEMO/OPA 3.3 , NEMO-Consortium (2010)  
     66   !! NEMO/OPA 3.7 , NEMO-Consortium (2015)  
    6767   !! $Id$ 
    6868   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    120120      !!---------------------------------------------------------------------- 
    121121      ! 
    122       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_init') 
     122      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init') 
    123123      ! 
    124124      IF(lwp) WRITE(numout,*) 
     
    270270      INTEGER, INTENT( in ), OPTIONAL ::   kcall   ! optional argument indicating call sequence 
    271271      ! 
    272       INTEGER                                :: ji, jj, jk            ! dummy loop indices 
    273       INTEGER , DIMENSION(3)                 :: ijk_max, ijk_min      ! temporary integers 
    274       REAL(wp)                               :: z2dt                  ! temporary scalars 
    275       REAL(wp)                               :: z_tmin, z_tmax        ! temporary scalars 
    276       LOGICAL                                :: ll_do_bclinic         ! temporary logical 
    277       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t 
    278       REAL(wp), POINTER, DIMENSION(:,:  ) :: zht, z_scale, zwu, zwv, zhdiv 
     272      INTEGER                ::   ji, jj, jk            ! dummy loop indices 
     273      INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers 
     274      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
     275      LOGICAL                ::   ll_do_bclinic         ! local logical 
     276      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t 
     277      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv 
    279278      !!---------------------------------------------------------------------- 
    280279      ! 
    281280      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    282281      ! 
    283       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_nxt') 
     282      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt') 
    284283      ! 
    285284      CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv ) 
    286285      CALL wrk_alloc( jpi,jpj,jpk,   ze3t ) 
    287286 
    288       IF(kt == nit000)  THEN 
     287      IF( kt == nit000 ) THEN 
    289288         IF(lwp) WRITE(numout,*) 
    290289         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_nxt : compute after scale factors' 
     
    312311      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
    313312         !                                                            ! ------baroclinic part------ ! 
    314  
    315313         ! I - initialization 
    316314         ! ================== 
     
    638636               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    639637               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
    640                gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
    641                    &               + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk))  
     638               gdept_n(ji,jj,jk) =    zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk) )  & 
     639                   &             + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk) )  
    642640               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 
    643641            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5866 r6004  
    158158      ! 
    159159      IF( nprint == 1 .AND. lwp )   THEN 
    160          WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
     160         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    161161         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   & 
    162             &                   ' w ',  MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 
    163          WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ),  & 
    164             &                   ' u ',   MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ),  & 
    165             &                   ' uw',   MINVAL( e3uw_0(:,:,:)), ' vw', MINVAL( e3vw_0(:,:,:)),   & 
    166             &                   ' w ',   MINVAL( e3w_0(:,:,:) ) 
     162            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 
     163         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(  e3f_0(:,:,:) ),  & 
     164            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(  e3v_0(:,:,:) ),  & 
     165            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL( e3vw_0(:,:,:)),   & 
     166            &                          ' w ', MINVAL(  e3w_0(:,:,:) ) 
    167167 
    168168         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   & 
    169             &                   ' w ',  MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) ) 
    170          WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ),  & 
    171             &                   ' u ',   MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ),  & 
    172             &                   ' uw',   MAXVAL( e3uw_0(:,:,:)), ' vw', MAXVAL( e3vw_0(:,:,:)),   & 
    173             &                   ' w ',   MAXVAL( e3w_0(:,:,:) ) 
     169            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) ) 
     170         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(  e3f_0(:,:,:) ),  & 
     171            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(  e3v_0(:,:,:) ),  & 
     172            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  & 
     173            &                          ' w ', MAXVAL(  e3w_0(:,:,:) ) 
    174174      ENDIF 
    175175      ! 
     
    910910      !!                      
    911911      !! ** Purpose :   the depth and vertical scale factor in partial step 
    912       !!      reference z-coordinate case 
     912      !!              reference z-coordinate case 
    913913      !! 
    914914      !! ** Method  :   Partial steps : computes the 3D vertical scale factors 
     
    11801180      ! Compute gde3w_0 (vertical sum of e3w) 
    11811181      IF ( ln_isfcav ) THEN ! if cavity 
    1182          WHERE (misfdep == 0) misfdep = 1 
     1182         WHERE( misfdep == 0 )  misfdep = 1 
    11831183         DO jj = 1,jpj 
    11841184            DO ji = 1,jpi 
     
    11871187                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    11881188               END DO 
    1189                IF (misfdep(ji,jj) .GE. 2) gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
     1189               IF( misfdep(ji,jj) >= 2 )  gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
    11901190               DO jk = misfdep(ji,jj) + 1, jpk 
    11911191                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
     
    12351235      !!--------------------------------------------------------------------- 
    12361236      ! 
    1237       IF( nn_timing == 1 )  CALL timing_start('zgr_isf') 
     1237      IF( nn_timing == 1 )   CALL timing_start('zgr_isf') 
    12381238      ! 
    12391239      CALL wrk_alloc( jpi,jpj,   zbathy, zmask, zrisfdep) 
     
    17071707      CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 
    17081708      ! 
    1709       IF( nn_timing == 1 )  CALL timing_stop('zgr_isf') 
     1709      IF( nn_timing == 1 )   CALL timing_stop('zgr_isf') 
    17101710      !       
    17111711   END SUBROUTINE 
     
    20292029      CALL lbc_lnk( e3uw_0, 'U', 1._wp ) 
    20302030      CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    2031  
    2032       gdepw_n(:,:,:) = gdepw_0(:,:,:) 
    20332031      ! 
    20342032      WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp 
     
    25622560      ! 
    25632561      zn1  =  1._wp / REAL( jpkm1, wp ) 
    2564       zn2  =  1. -  zn1 
     2562      zn2  =  1._wp -  zn1 
    25652563      ! 
    25662564      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp)  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r5883 r6004  
    3535   USE dtauvd          ! data: U & V current             (dta_uvd routine) 
    3636   USE domvvl          ! varying vertical mesh 
    37    USE dynspg_oce      ! pressure gradient schemes 
    38    USE dynspg_flt      ! filtered free surface 
    39    USE sol_oce         ! ocean solver variables 
    4037   ! 
    4138   USE in_out_manager  ! I/O manager 
     
    133130         !  
    134131      ENDIF 
    135       ! 
    136       IF( lk_agrif ) THEN                  ! read free surface arrays in restart file 
    137          IF( ln_rstart ) THEN 
    138             IF( lk_dynspg_flt )  THEN      ! read or initialize the following fields 
    139                !                           ! gcx, gcxb for agrif_opa_init 
    140                IF( sol_oce_alloc()  > 0 )   CALL ctl_stop('agrif sol_oce_alloc: allocation of arrays failed') 
    141                CALL flt_rst( nit000, 'READ' ) 
    142             ENDIF 
    143          ENDIF                             ! explicit case not coded yet with AGRIF 
    144       ENDIF 
    145       ! 
    146132      !  
    147133      ! Initialize "now" and "before" barotropic velocities: 
    148       ! Do it whatever the free surface method, these arrays 
    149       ! being eventually used 
    150       ! 
     134      ! Do it whatever the free surface method, these arrays being eventually used 
    151135      ! 
    152136      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
    153137      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    154138      ! 
     139!!gm  the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked 
    155140      DO jk = 1, jpkm1 
    156141         DO jj = 1, jpj 
     
    165150      END DO 
    166151      ! 
    167       un_b(:,:) = un_b(:,:) * r1_hu_n  (:,:) 
    168       vn_b(:,:) = vn_b(:,:) * r1_hv_n  (:,:) 
     152      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 
     153      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 
    169154      ! 
    170155      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    171156      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    172       ! 
    173157      ! 
    174158      IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
     
    438422      !!                 p=integral [ rau*g dz ] 
    439423      !!---------------------------------------------------------------------- 
    440       USE dynspg          ! surface pressure gradient             (dyn_spg routine) 
    441424      USE divhor          ! hor. divergence                       (div_hor routine) 
    442425      USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    443426      ! 
    444427      INTEGER ::   ji, jj, jk        ! dummy loop indices 
    445       INTEGER ::   indic             ! ??? 
    446428      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars 
    447429      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn 
     
    510492      vb(:,:,:) = vn(:,:,:) 
    511493       
    512       ! WARNING !!!!! 
    513       ! after initializing u and v, we need to calculate the initial streamfunction bsf. 
    514       ! Otherwise, only the trend will be computed and the model will blow up (inconsistency). 
    515       ! to do that, we call dyn_spg with a special trick: 
    516       ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the 
    517       ! right value assuming the velocities have been set up in one time step. 
    518       ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.) 
    519       !  sets up s false trend to calculate the barotropic streamfunction. 
    520  
    521       ua(:,:,:) = ub(:,:,:) / rdt 
    522       va(:,:,:) = vb(:,:,:) / rdt 
    523  
    524       ! calls dyn_spg. we assume euler time step, starting from rest. 
    525       indic = 0 
    526       CALL dyn_spg( nit000, indic )       ! surface pressure gradient 
    527       ! 
    528       ! the new velocity is ua*rdt 
    529       ! 
    530       CALL lbc_lnk( ua, 'U', -1. ) 
    531       CALL lbc_lnk( va, 'V', -1. ) 
    532  
    533       ub(:,:,:) = ua(:,:,:) * rdt 
    534       vb(:,:,:) = va(:,:,:) * rdt 
    535       ua(:,:,:) = 0.e0 
    536       va(:,:,:) = 0.e0 
    537       un(:,:,:) = ub(:,:,:) 
    538       vn(:,:,:) = vb(:,:,:) 
    539494      ! 
    540495!!gm  Check  here call to div_hor should not be necessary 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r5845 r6004  
    9797      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    9898901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
    99  
     99      ! 
    100100      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 
    101101      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r5883 r6004  
    5151      ! 
    5252      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    53       REAL(wp) ::   zbu, zbv     ! local scalars 
    5453      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
    5554      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
     
    5857      IF( nn_timing == 1 )  CALL timing_start('dyn_adv_cen2') 
    5958      ! 
    60       CALL wrk_alloc( jpi, jpj, jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
     59      CALL wrk_alloc( jpi,jpj,jpk,  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    6160      ! 
    6261      IF( kt == nit000 .AND. lwp ) THEN 
     
    7473      ! 
    7574      DO jk = 1, jpkm1                    ! horizontal transport 
    76          zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
    77          zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     75         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     76         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    7877         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point) 
    7978            DO ji = 1, fs_jpim1   ! vector opt. 
     
    8685         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes 
    8786            DO ji = fs_2, fs_jpim1   ! vector opt. 
    88                zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    89                zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    90                ! 
    9187               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    92                   &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) / zbu 
     88                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    9389               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
    94                   &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) / zbv 
     90                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    9591            END DO 
    9692         END DO 
     
    134130         END DO 
    135131      END DO 
    136       ! 
    137132      DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence 
    138133         DO jj = 2, jpjm1  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r5883 r6004  
    7070      !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.  
    7171      !!---------------------------------------------------------------------- 
    72       INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
    73       ! 
    74       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    75       REAL(wp) ::   zbu, zbv    ! temporary scalars 
    76       REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars 
     72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     73      ! 
     74      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     75      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars 
    7776      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu, zfv 
    7877      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
     
    8281      IF( nn_timing == 1 )  CALL timing_start('dyn_adv_ubs') 
    8382      ! 
    84       CALL wrk_alloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    85       CALL wrk_alloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
     83      CALL wrk_alloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
     84      CALL wrk_alloc( jpi,jpj,jpk,jpts,  zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
    8685      ! 
    8786      IF( kt == nit000 ) THEN 
     
    139138      DO jk = 1, jpkm1                       ! ====================== ! 
    140139         !                                         ! horizontal volume fluxes 
    141          zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
    142          zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     140         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     141         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    143142         ! 
    144143         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point 
     
    178177         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    179178            DO ji = fs_2, fs_jpim1   ! vector opt. 
    180                zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    181                zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    182                ! 
    183                ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
    184                   &                           + zfv_f(ji  ,jj  ,jk) - zfv_f(ji  ,jj-1,jk)  ) / zbu 
    185                va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji  ,jj  ,jk) - zfu_f(ji-1,jj  ,jk)    & 
    186                   &                           + zfv_t(ji  ,jj+1,jk) - zfv_t(ji  ,jj  ,jk)  ) / zbv 
     179               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
     180                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     181               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
     182                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    187183            END DO 
    188184         END DO 
     
    217213         DO jj = 2, jpjm1 
    218214            DO ji = fs_2, fs_jpim1 
    219                zfw(ji,jj,jk) = 0.25 * e1e2t(ji,jj) * wn(ji,jj,jk) 
     215               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    220216            END DO 
    221217         END DO 
     
    245241         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    246242      ! 
    247       CALL wrk_dealloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    248       CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
     243      CALL wrk_dealloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
     244      CALL wrk_dealloc( jpi,jpj,jpk,jpts,  zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
    249245      ! 
    250246      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs') 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r5866 r6004  
    3636   USE trd_oce         ! trends: ocean variables 
    3737   USE trddyn          ! trend manager: dynamics 
     38!jc   USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
    3839   ! 
    3940   USE in_out_manager  ! I/O manager 
     
    5152   PUBLIC   dyn_hpg_init   ! routine called by opa module 
    5253 
    53    !                                    !!* Namelist namdyn_hpg : hydrostatic pressure gradient 
    54    LOGICAL , PUBLIC ::   ln_hpg_zco      !: z-coordinate - full steps 
    55    LOGICAL , PUBLIC ::   ln_hpg_zps      !: z-coordinate - partial steps (interpolation) 
    56    LOGICAL , PUBLIC ::   ln_hpg_sco      !: s-coordinate (standard jacobian formulation) 
    57    LOGICAL , PUBLIC ::   ln_hpg_djc      !: s-coordinate (Density Jacobian with Cubic polynomial) 
    58    LOGICAL , PUBLIC ::   ln_hpg_prj      !: s-coordinate (Pressure Jacobian scheme) 
    59    LOGICAL , PUBLIC ::   ln_hpg_isf      !: s-coordinate similar to sco modify for isf 
    60    LOGICAL , PUBLIC ::   ln_dynhpg_imp   !: semi-implicite hpg flag 
     54   !                                 !!* Namelist namdyn_hpg : hydrostatic pressure gradient 
     55   LOGICAL , PUBLIC ::   ln_hpg_zco   !: z-coordinate - full steps 
     56   LOGICAL , PUBLIC ::   ln_hpg_zps   !: z-coordinate - partial steps (interpolation) 
     57   LOGICAL , PUBLIC ::   ln_hpg_sco   !: s-coordinate (standard jacobian formulation) 
     58   LOGICAL , PUBLIC ::   ln_hpg_djc   !: s-coordinate (Density Jacobian with Cubic polynomial) 
     59   LOGICAL , PUBLIC ::   ln_hpg_prj   !: s-coordinate (Pressure Jacobian scheme) 
     60   LOGICAL , PUBLIC ::   ln_hpg_isf   !: s-coordinate similar to sco modify for isf 
    6161 
    6262   INTEGER , PUBLIC ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) (PUBLIC for TAM) 
     
    131131      !! 
    132132      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     & 
    133          &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf, ln_dynhpg_imp 
     133         &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf 
    134134      !!---------------------------------------------------------------------- 
    135135      ! 
    136136      REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient 
    137137      READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901) 
    138 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp ) 
    139  
     138901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp ) 
     139      ! 
    140140      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient 
    141141      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 ) 
    142 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 
     142902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 
    143143      IF(lwm) WRITE ( numond, namdyn_hpg ) 
    144144      ! 
     
    154154         WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc 
    155155         WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj 
    156          WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp 
    157156      ENDIF 
    158157      ! 
     
    162161                           & either  ln_hpg_sco or  ln_hpg_prj instead') 
    163162      ! 
    164       IF( .NOT.ln_linssh .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )       & 
     163      IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )        & 
    165164         &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', & 
    166165         &                 '   the standard jacobian formulation hpg_sco    or '    , & 
     
    219218      !!---------------------------------------------------------------------- 
    220219      ! 
    221       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 
     220      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    222221      ! 
    223222      IF( kt == nit000 ) THEN 
     
    250249               ! hydrostatic pressure gradient 
    251250               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    252                   &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   & 
     251                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    & 
    253252                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    254253 
    255254               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    256                   &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   & 
     255                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    & 
    257256                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    258257               ! add to the general momentum trend 
     
    263262      END DO 
    264263      ! 
    265       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 
     264      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    266265      ! 
    267266   END SUBROUTINE hpg_zco 
     
    284283      !!---------------------------------------------------------------------- 
    285284      ! 
    286       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 
     285      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    287286      ! 
    288287      IF( kt == nit000 ) THEN 
     
    292291      ENDIF 
    293292 
     293      ! Partial steps: bottom before horizontal gradient of t, s, rd at the last ocean level 
     294!jc      CALL zps_hde    ( kt, jpts, tsn, gtsu, gtsv, rhd, gru , grv ) 
    294295 
    295296      ! Local constant initialization 
     
    309310      END DO 
    310311 
    311  
    312312      ! interior value (2=<jk=<jpkm1) 
    313313      DO jk = 2, jpkm1 
     
    329329         END DO 
    330330      END DO 
    331  
    332331 
    333332      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
     
    353352      END DO 
    354353      ! 
    355       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 
     354      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    356355      ! 
    357356   END SUBROUTINE hpg_zps 
     357 
    358358 
    359359   SUBROUTINE hpg_sco( kt ) 
     
    389389         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used' 
    390390      ENDIF 
    391  
    392       ! Local constant initialization 
     391      ! 
    393392      zcoef0 = - grav * 0.5_wp 
    394       ! To use density and not density anomaly 
    395       IF ( .NOT.ln_linssh ) THEN   ;     znad = 1._wp          ! Variable volume 
    396       ELSE                         ;     znad = 0._wp         ! Fixed volume 
     393      IF ( ln_linssh ) THEN   ;   znad = 0._wp         ! Fixed    volume: density anomaly 
     394      ELSE                    ;   znad = 1._wp         ! Variable volume: density 
    397395      ENDIF 
    398  
     396      ! 
    399397      ! Surface value 
    400398      DO jj = 2, jpjm1 
    401399         DO ji = fs_2, fs_jpim1   ! vector opt. 
    402400            ! hydrostatic pressure gradient along s-surfaces 
    403             zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )  & 
    404                &                                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) 
    405             zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )  & 
    406                &                                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) 
     401            zhpi(ji,jj,1) = zcoef0 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    & 
     402               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj) 
     403            zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    & 
     404               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj) 
    407405            ! s-coordinate pressure gradient correction 
    408406            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     
    443441   END SUBROUTINE hpg_sco 
    444442 
     443 
    445444   SUBROUTINE hpg_isf( kt ) 
    446445      !!--------------------------------------------------------------------- 
     
    471470      !!---------------------------------------------------------------------- 
    472471      ! 
    473       CALL wrk_alloc( jpi,jpj, 2, ztstop)  
    474       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj, zrhd) 
    475       CALL wrk_alloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj)  
    476       ! 
    477      IF( kt == nit000 ) THEN 
     472      CALL wrk_alloc( jpi,jpj,  2,   ztstop )  
     473      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj, zrhd) 
     474      CALL wrk_alloc( jpi,jpj,       ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj )  
     475      ! 
     476      IF( kt == nit000 ) THEN 
    478477         IF(lwp) WRITE(numout,*) 
    479478         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf' 
    480479         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used' 
    481480      ENDIF 
    482  
    483       ! Local constant initialization 
     481      ! 
    484482      zcoef0 = - grav * 0.5_wp 
    485       ! To use density and not density anomaly 
    486 !      IF ( .NOT.ln_linssh ) THEN   ;     znad = 1._wp          ! Variable volume 
    487 !      ELSE                         ;     znad = 0._wp         ! Fixed volume 
    488 !      ENDIF 
    489       znad=1._wp 
    490       ! iniitialised to 0. zhpi zhpi  
    491       zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp 
     483      IF( ln_linssh ) THEN   ;   znad = 0._wp      ! Fixed    volume: density anomaly 
     484      ELSE                   ;   znad = 1._wp      ! Variable volume: density 
     485      ENDIF 
     486      zhpi(:,:,:) = 0._wp 
     487      zhpj(:,:,:) = 0._wp 
    492488 
    493489!==================================================================================      
     
    496492 
    497493      ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    498       ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 
     494      ztstop(:,:,jp_tem) = -1.9_wp 
     495      ztstop(:,:,jp_sal) = 34.4_wp 
     496 
     497!!gm I have the feeling that a much simplier and faster computation can be performed... 
     498!!gm     ====>>>>   We have to discuss ! 
     499 
     500!!gm below, faster to compute the ISF density in zrhd and remplace rhd value where tmask=0 
     501!!gm        furthermore, this calculation does not depends on time :  do it at the first time-step only.... 
    499502 
    500503      ! compute density of the water displaced by the ice shelf  
    501       zrhd = rhd ! save rhd 
     504      zrhd(:,:,:) = rhd(:,:,:)    ! save rhd 
    502505      DO jk = 1, jpk 
    503            zdept(:,:)=gdept_1d(jk) 
    504            CALL eos(ztstop(:,:,:),zdept(:,:),rhd(:,:,jk)) 
    505       END DO 
    506       WHERE ( tmask(:,:,:) == 1._wp) 
     506         zdept(:,:) = gdept_1d(jk) 
     507         CALL eos( ztstop(:,:,:), zdept(:,:), rhd(:,:,jk) ) 
     508      END DO 
     509      WHERE( tmask(:,:,:) == 1._wp ) 
    507510        rhd(:,:,:) = zrhd(:,:,:) ! replace wet cell by the saved rhd 
    508511      END WHERE 
    509512       
    510513      ! compute rhd at the ice/oce interface (ice shelf side) 
    511       CALL eos(ztstop,risfdep,zrhdtop_isf) 
     514      CALL eos( ztstop, risfdep, zrhdtop_isf ) 
    512515 
    513516      ! compute rhd at the ice/oce interface (ocean side) 
    514       DO ji=1,jpi 
    515         DO jj=1,jpj 
    516           ikt=mikt(ji,jj) 
    517           ztstop(ji,jj,1)=tsn(ji,jj,ikt,1) 
    518           ztstop(ji,jj,2)=tsn(ji,jj,ikt,2) 
     517      DO ji = 1, jpi 
     518        DO jj = 1, jpj 
     519          ikt = mikt(ji,jj) 
     520          ztstop(ji,jj,jp_tem) = tsn(ji,jj,ikt,jp_tem) 
     521          ztstop(ji,jj,jp_sal) = tsn(ji,jj,ikt,jp_sal) 
    519522        END DO 
    520523      END DO 
    521       CALL eos(ztstop,risfdep,zrhdtop_oce) 
     524      CALL eos( ztstop, risfdep, zrhdtop_oce ) 
    522525      ! 
    523526      ! Surface value + ice shelf gradient 
     
    526529      DO jj = 1, jpj 
    527530         DO ji = 1, jpi   ! vector opt. 
    528             ikt=mikt(ji,jj) 
     531            ikt = mikt(ji,jj) 
    529532            ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
    530             DO jk=2,ikt-1 
     533            DO jk = 2, ikt-1 
    531534               ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 
    532535                  &                              * (1._wp - tmask(ji,jj,jk)) 
    533536            END DO 
    534             IF (ikt .GE. 2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + rhd(ji,jj,ikt-1)) & 
    535                                &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
    536          END DO 
    537       END DO 
    538       riceload(:,:) = 0.0_wp ; riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
     537            IF( ikt >= 2 )  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + rhd(ji,jj,ikt-1)) & 
     538               &                                               * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
     539         END DO 
     540      END DO 
     541      riceload(:,:) = 0._wp   ;   riceload(:,:) = ziceload(:,:)   ! need to be saved for diaar5 
    539542      ! compute zp from z=0 to first T wet point (correction due to zps not yet applied) 
    540543      DO jj = 2, jpjm1 
    541544         DO ji = fs_2, fs_jpim1   ! vector opt. 
    542             ikt=mikt(ji,jj) ; iktp1i=mikt(ji+1,jj); iktp1j=mikt(ji,jj+1) 
     545            ikt    = mikt(ji,jj) 
     546            iktp1i = mikt(ji+1,jj) 
     547            iktp1j = mikt(ji,jj+1) 
    543548            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
    544549            ! we assume ISF is in isostatic equilibrium 
    545             zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj  ,iktp1i)                                  & 
    546                &                                   * ( 2._wp * znad + rhd(ji+1,jj  ,iktp1i) + zrhdtop_oce(ji+1,jj  ) )   & 
    547                &                                   - 0.5_wp * e3w_n(ji  ,jj  ,ikt   )                                    & 
    548                &                                   * ( 2._wp * znad + rhd(ji  ,jj  ,ikt   ) + zrhdtop_oce(ji  ,jj  ) )   & 
    549                &                                   + ( ziceload(ji+1,jj) - ziceload(ji,jj) )                             )  
    550             zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( 0.5_wp * e3w_n(ji  ,jj+1,iktp1j)                                  & 
    551                &                                   * ( 2._wp * znad + rhd(ji  ,jj+1,iktp1j) + zrhdtop_oce(ji  ,jj+1) )   & 
    552                &                                   - 0.5_wp * e3w_n(ji  ,jj  ,ikt   )                                    &  
    553                &                                   * ( 2._wp * znad + rhd(ji  ,jj  ,ikt   ) + zrhdtop_oce(ji  ,jj  ) )   & 
    554                &                                   + ( ziceload(ji,jj+1) - ziceload(ji,jj) )                             )  
     550            zhpi(ji,jj,1) = zcoef0 * (                                    & 
     551               &            0.5_wp * e3w_n(ji+1,jj,iktp1i) * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   & 
     552               &          - 0.5_wp * e3w_n(ji  ,jj,ikt   ) * ( 2._wp * znad + rhd(ji  ,jj,ikt   ) + zrhdtop_oce(ji  ,jj) )   & 
     553               &          + ( ziceload(ji+1,jj) - ziceload(ji,jj) )       ) * r1_e1u(ji,jj) 
     554            zhpj(ji,jj,1) = zcoef0 * (                                    & 
     555               &            0.5_wp * e3w_n(ji,jj+1,iktp1j) * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   & 
     556               &          - 0.5_wp * e3w_n(ji,jj  ,ikt   ) * ( 2._wp * znad + rhd(ji,jj  ,ikt   ) + zrhdtop_oce(ji,jj  ) )   & 
     557               &          + ( ziceload(ji,jj+1) - ziceload(ji,jj) )       ) * r1_e2v(ji,jj) 
    555558            ! s-coordinate pressure gradient correction (=0 if z coordinate) 
    556559            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     
    569572         DO ji = fs_2, fs_jpim1   ! vector opt. 
    570573            iku = miku(ji,jj) 
    571             zpshpi(ji,jj) = 0._wp   ;   zpshpj(ji,jj) = 0._wp 
     574            zpshpi(ji,jj) = 0._wp 
     575            zpshpj(ji,jj) = 0._wp 
    572576            ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
    573577            ! u direction 
    574             IF ( iku .GT. 1 ) THEN 
     578            IF( iku > 1 ) THEN 
    575579               ! case iku 
    576                zhpi(ji,jj,iku)   =  zcoef0 * r1_e1u(ji,jj) * ze3wu                                         & 
    577                       &                                 * ( rhd    (ji+1,jj,iku) + rhd   (ji,jj,iku)       & 
    578                       &                                   + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad ) 
     580               zhpi(ji,jj,iku) = zcoef0 * r1_e1u(ji,jj) * ze3wu                             & 
     581                  &                     * ( rhd(ji+1,jj,iku) + rhd(ji,jj,iku)               & 
     582                  &                        + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad ) 
    579583               ! corrective term ( = 0 if z coordinate ) 
    580                zuap              = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) * r1_e1u(ji,jj) 
     584               zuap = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) * r1_e1u(ji,jj) 
    581585               ! zhpi will be added in interior loop 
    582                ua(ji,jj,iku)     = ua(ji,jj,iku) + zuap 
     586               ua(ji,jj,iku) = ua(ji,jj,iku) + zuap 
    583587               ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure   
    584                IF (mbku(ji,jj) == iku + 1) zpshpi(ji,jj) = zhpi(ji,jj,iku) 
     588               IF( mbku(ji,jj) == iku + 1 )   zpshpi(ji,jj) = zhpi(ji,jj,iku) 
    585589 
    586590               ! case iku + 1 (remove the zphi term added in the interior loop and compute the one corrected for zps) 
    587                zhpiint        =  zcoef0 * r1_e1u(ji,jj)                                                               &     
    588                   &           * (  e3w_n(ji+1,jj  ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad)                          & 
    589                   &                                         + (rhd(ji+1,jj,iku  ) + znad) ) * tmask(ji+1,jj,iku)   & 
    590                   &              - e3w_n(ji  ,jj  ,iku+1) * ( (rhd(ji  ,jj,iku+1) + znad)                          & 
    591                   &                                         + (rhd(ji  ,jj,iku  ) + znad) ) * tmask(ji  ,jj,iku)   ) 
    592                zhpi(ji,jj,iku+1) =  zcoef0 * r1_e1u(ji,jj) * ge3rui(ji,jj) - zhpiint  
     591               zhpiint = zcoef0 * r1_e1u(ji,jj)                                                              &     
     592                  &    * (  e3w_n(ji+1,jj  ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad)                          & 
     593                  &                                   + (rhd(ji+1,jj,iku  ) + znad) ) * tmask(ji+1,jj,iku)   & 
     594                  &       - e3w_n(ji  ,jj  ,iku+1) * ( (rhd(ji  ,jj,iku+1) + znad)                          & 
     595                  &                                   + (rhd(ji  ,jj,iku  ) + znad) ) * tmask(ji  ,jj,iku)   ) 
     596               zhpi(ji,jj,iku+1) = zcoef0 * r1_e1u(ji,jj) * ge3rui(ji,jj) - zhpiint  
    593597            END IF 
    594598                
     
    596600            ikv = mikv(ji,jj) 
    597601            ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
    598             IF ( ikv .GT. 1 ) THEN 
     602            IF( ikv > 1 ) THEN 
    599603               ! case ikv 
    600                zhpj(ji,jj,ikv)   =  zcoef0 * r1_e2v(ji,jj) * ze3wv                                            & 
    601                      &                                     * ( rhd(ji,jj+1,ikv) + rhd   (ji,jj,ikv)           & 
    602                      &                                       + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad ) 
     604               zhpj(ji,jj,ikv) =  zcoef0 * r1_e2v(ji,jj) * ze3wv                             & 
     605                  &                      * ( rhd(ji,jj+1,ikv) + rhd(ji,jj,ikv)               & 
     606                  &                         + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad ) 
    603607               ! corrective term ( = 0 if z coordinate ) 
    604                zvap              = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) * r1_e2v(ji,jj) 
     608               zvap = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) * r1_e2v(ji,jj) 
    605609               ! zhpi will be added in interior loop 
    606                va(ji,jj,ikv)      = va(ji,jj,ikv) + zvap 
     610               va(ji,jj,ikv) = va(ji,jj,ikv) + zvap 
    607611               ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure   
    608                IF (mbkv(ji,jj) == ikv + 1)  zpshpj(ji,jj)  = zhpj(ji,jj,ikv)  
     612               IF( mbkv(ji,jj) == ikv + 1 )   zpshpj(ji,jj) = zhpj(ji,jj,ikv)  
    609613                
    610614               ! case ikv + 1 (remove the zphj term added in the interior loop and compute the one corrected for zps) 
    611                zhpjint        =  zcoef0 * r1_e2v(ji,jj)                                                           & 
    612                   &           * (  e3w_n(ji  ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad)                         & 
    613                   &                                       + (rhd(ji,jj+1,ikv  ) + znad) ) * tmask(ji,jj+1,ikv)    & 
    614                   &              - e3w_n(ji  ,jj  ,ikv+1) * ( (rhd(ji,jj  ,ikv+1) + znad)                         & 
    615                   &                                       + (rhd(ji,jj  ,ikv  ) + znad) ) * tmask(ji,jj  ,ikv)  ) 
     615               zhpjint =  zcoef0 * r1_e2v(ji,jj)                                                            & 
     616                  &    * (  e3w_n(ji  ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad)                         & 
     617                  &                                   + (rhd(ji,jj+1,ikv  ) + znad) ) * tmask(ji,jj+1,ikv)  & 
     618                  &       - e3w_n(ji  ,jj  ,ikv+1) * ( (rhd(ji,jj  ,ikv+1) + znad)                         & 
     619                  &                                   + (rhd(ji,jj  ,ikv  ) + znad) ) * tmask(ji,jj  ,ikv)  ) 
    616620               zhpj(ji,jj,ikv+1) =  zcoef0 * r1_e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 
    617             END IF 
     621            ENDIF 
    618622         END DO 
    619623      END DO 
     
    969973      ! Local constant initialization 
    970974      zcoef0 = - grav 
    971       znad = 0.0_wp 
    972       IF( .NOT.ln_linssh )   znad = 1._wp 
     975      znad = 1._wp 
     976      IF( ln_linssh )   znad = 0._wp 
    973977 
    974978      ! Clean 3-D work arrays 
     
    12031207               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
    12041208               IF( .NOT.ln_linssh ) THEN 
    1205                    zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
    1206                            ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
     1209                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
     1210                          ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
    12071211               ELSE 
    1208                    zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
     1212                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    12091213               ENDIF 
    12101214!!gm  Since vmask(:,jj,:) = tmask(:,jj,:) * tmask(:,jj+1,:)  by definition 
     
    12341238      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    12351239      !!---------------------------------------------------------------------- 
    1236       IMPLICIT NONE 
    1237       REAL(wp), DIMENSION(:,:,:), INTENT(in)  :: fsp, xsp           ! value and coordinate 
    1238       REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of 
    1239                                                                     ! the interpoated function 
    1240       INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline 
    1241                                                                     ! 2: Linear 
     1240      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate 
     1241      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function 
     1242      INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear 
    12421243      ! 
    12431244      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r5845 r6004  
    3636   PUBLIC   dyn_ldf_init  ! called by opa  module  
    3737 
    38    !                      ! Flag to control the type of lateral viscous operator 
     38   !                      ! Parameter to control the type of lateral viscous operator 
    3939   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in setting the operator 
    4040   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral viscous trend) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r5845 r6004  
    286286         DO jj = 2, jpjm1 
    287287            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug 
    288                ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj  )    & 
    289                   &                          + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    290                va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj  ) - zivf(ji-1,jj)    & 
    291                   &                          + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
     288               ua(ji,jj,jk) = ua(ji,jj,jk) + (  ziut(ji+1,jj) - ziut(ji,jj  )    & 
     289                  &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     290               va(ji,jj,jk) = va(ji,jj,jk) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    & 
     291                  &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    292292            END DO 
    293293         END DO 
     
    402402         DO jk = 1, jpkm1 
    403403            DO ji = 2, jpim1 
    404                ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    405                va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
     404               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     405               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    406406            END DO 
    407407         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r5866 r6004  
    1818   !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL 
    1919   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes 
    20    !!            3.7  !  2014-04  (G. Madec) add the diagnostic of the time filter trends 
     20   !!            3.6  !  2014-04  (G. Madec) add the diagnostic of the time filter trends 
     21   !!            3.7  !  2015-11  (J. Chanut) Free surface simplification 
    2122   !!------------------------------------------------------------------------- 
    2223   
    2324   !!------------------------------------------------------------------------- 
    24    !!   dyn_nxt      : obtain the next (after) horizontal velocity 
     25   !!   dyn_nxt       : obtain the next (after) horizontal velocity 
    2526   !!------------------------------------------------------------------------- 
    26    USE oce             ! ocean dynamics and tracers 
    27    USE dom_oce         ! ocean space and time domain 
    28    USE sbc_oce         ! Surface boundary condition: ocean fields 
    29    USE phycst          ! physical constants 
    30    USE dynspg_oce      ! type of surface pressure gradient 
    31    USE dynadv          ! dynamics: vector invariant versus flux form 
    32    USE domvvl          ! variable volume 
    33    USE bdy_oce         ! ocean open boundary conditions 
    34    USE bdydta          ! ocean open boundary conditions 
    35    USE bdydyn          ! ocean open boundary conditions 
    36    USE bdyvol          ! ocean open boundary condition (bdy_vol routines) 
    37    USE trd_oce         ! trends: ocean variables 
    38    USE trddyn          ! trend manager: dynamics 
    39    USE trdken          ! trend manager: kinetic energy 
     27   USE oce            ! ocean dynamics and tracers 
     28   USE dom_oce        ! ocean space and time domain 
     29   USE sbc_oce        ! Surface boundary condition: ocean fields 
     30   USE phycst         ! physical constants 
     31   USE dynadv         ! dynamics: vector invariant versus flux form 
     32   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme 
     33   USE domvvl         ! variable volume 
     34   USE bdy_oce        ! ocean open boundary conditions 
     35   USE bdydta         ! ocean open boundary conditions 
     36   USE bdydyn         ! ocean open boundary conditions 
     37   USE bdyvol         ! ocean open boundary condition (bdy_vol routines) 
     38   USE trd_oce        ! trends: ocean variables 
     39   USE trddyn         ! trend manager: dynamics 
     40   USE trdken         ! trend manager: kinetic energy 
    4041   ! 
    41    USE in_out_manager  ! I/O manager 
    42    USE iom             ! I/O manager library 
    43    USE lbclnk          ! lateral boundary condition (or mpp link) 
    44    USE lib_mpp         ! MPP library 
    45    USE wrk_nemo        ! Memory Allocation 
    46    USE prtctl          ! Print control 
    47    USE timing          ! Timing 
     42   USE in_out_manager ! I/O manager 
     43   USE iom            ! I/O manager library 
     44   USE lbclnk         ! lateral boundary condition (or mpp link) 
     45   USE lib_mpp        ! MPP library 
     46   USE wrk_nemo       ! Memory Allocation 
     47   USE prtctl         ! Print control 
     48   USE timing         ! Timing 
    4849#if defined key_agrif 
    4950   USE agrif_opa_interp 
     
    6667      !!                  ***  ROUTINE dyn_nxt  *** 
    6768      !!                    
    68       !! ** Purpose :   Compute the after horizontal velocity. Apply the boundary  
    69       !!             condition on the after velocity, achieved the time stepping  
     69      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary  
     70      !!             condition on the after velocity, achieve the time stepping  
    7071      !!             by applying the Asselin filter on now fields and swapping  
    7172      !!             the fields. 
    7273      !! 
    73       !! ** Method  : * After velocity is compute using a leap-frog scheme: 
    74       !!                       (ua,va) = (ub,vb) + 2 rdt (ua,va) 
    75       !!             Note that with flux form advection and non linear free surface, 
    76       !!             the leap-frog is applied on thickness weighted velocity. 
    77       !!             Note also that in filtered free surface (lk_dynspg_flt=T), 
    78       !!             the time stepping has already been done in dynspg module 
     74      !! ** Method  : * Ensure after velocities transport matches time splitting 
     75      !!             estimate (ln_dynspg_ts=T) 
    7976      !! 
    8077      !!              * Apply lateral boundary conditions on after velocity  
     
    8986      !!             Note that with flux form advection and non linear free surface, 
    9087      !!             the time filter is applied on thickness weighted velocity. 
     88      !!             As a result, dyn_nxt MUST be called after tra_nxt. 
    9189      !! 
    9290      !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step 
     
    9795      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    9896      INTEGER  ::   iku, ikv     ! local integers 
    99 #if ! defined key_dynspg_flt 
    100       REAL(wp) ::   z2dt         ! temporary scalar 
    101 #endif 
    102       REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec      ! local scalars 
     97      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars 
    10398      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
    10499      REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve 
     
    108103      IF( nn_timing == 1 )   CALL timing_start('dyn_nxt') 
    109104      ! 
    110       CALL wrk_alloc( jpi,jpj,jpk,  ze3u_f, ze3v_f, zua, zva ) 
    111       IF( lk_dynspg_ts )   CALL wrk_alloc( jpi,jpj, zue, zve ) 
     105      IF( ln_dynspg_ts       )   CALL wrk_alloc( jpi,jpj,       zue, zve) 
     106      IF( l_trddyn           )   CALL wrk_alloc( jpi,jpj,jpk,   zua, zva) 
    112107      ! 
    113108      IF( kt == nit000 ) THEN 
     
    117112      ENDIF 
    118113 
    119 #if defined key_dynspg_flt 
    120       ! 
    121       ! Next velocity :   Leap-frog time stepping already done in dynspg_flt.F routine 
    122       ! ------------- 
    123  
    124       ! Update after velocity on domain lateral boundaries      (only local domain required) 
    125       ! -------------------------------------------------- 
    126       CALL lbc_lnk( ua, 'U', -1. )         ! local domain boundaries 
    127       CALL lbc_lnk( va, 'V', -1. )  
    128       ! 
    129 #else 
    130  
    131 # if defined key_dynspg_exp 
    132       ! Next velocity :   Leap-frog time stepping 
    133       ! ------------- 
    134       z2dt = 2. * rdt                                 ! Euler or leap-frog time step  
    135       IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt 
    136       ! 
    137       IF( ln_dynadv_vec .OR. ln_linssh ) THEN         !==  applied on velocity  ==! 
     114      IF ( ln_dynspg_ts ) THEN 
     115         ! Ensure below that barotropic velocities match time splitting estimate 
     116         ! Compute actual transport and replace it with ts estimate at "after" time step 
     117         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
     118         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     119         DO jk = 2, jpkm1 
     120            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     121            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     122         END DO 
    138123         DO jk = 1, jpkm1 
    139             ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk) 
    140             va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk) 
     124            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
     125            va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    141126         END DO 
    142       ELSE                                            !==  applied on thickness weighted velocity  ==! 
    143          DO jk = 1, jpkm1 
    144             ua(:,:,jk) = (          ub(:,:,jk) * e3u_b(:,:,jk)    & 
    145                &           + z2dt * ua(:,:,jk) * e3u_n(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
    146             va(:,:,jk) = (          vb(:,:,jk) * e3v_b(:,:,jk)    & 
    147                &           + z2dt * va(:,:,jk) * e3v_n(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
    148          END DO 
    149       ENDIF 
    150 # endif 
    151  
    152 # if defined key_dynspg_ts 
    153 !!gm IF ( lk_dynspg_ts ) THEN .... 
    154       ! Ensure below that barotropic velocities match time splitting estimate 
    155       ! Compute actual transport and replace it with ts estimate at "after" time step 
    156       zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
    157       zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
    158       DO jk = 2, jpkm1 
    159          zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    160          zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    161       END DO 
    162       DO jk = 1, jpkm1 
    163          ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
    164          va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    165       END DO 
    166  
    167       IF (lk_dynspg_ts.AND.(.NOT.ln_bt_fw)) THEN 
    168          ! Remove advective velocity from "now velocities"  
    169          ! prior to asselin filtering      
    170          ! In the forward case, this is done below after asselin filtering    
    171          ! so that asselin contribution is removed at the same time  
    172          DO jk = 1, jpkm1 
    173             un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
    174             vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
    175          END DO   
    176       ENDIF 
    177 !!gm ENDIF 
    178 # endif 
     127         ! 
     128         IF( .NOT.ln_bt_fw ) THEN 
     129            ! Remove advective velocity from "now velocities"  
     130            ! prior to asselin filtering      
     131            ! In the forward case, this is done below after asselin filtering    
     132            ! so that asselin contribution is removed at the same time  
     133            DO jk = 1, jpkm1 
     134               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
     135               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
     136            END DO   
     137         ENDIF 
     138      ENDIF 
    179139 
    180140      ! Update after velocity on domain lateral boundaries 
    181141      ! --------------------------------------------------       
    182       CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries 
    183       CALL lbc_lnk( va, 'V', -1. )  
    184       ! 
    185 # if defined key_bdy 
    186       !                                !* BDY open boundaries 
    187       IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt ) 
    188       IF( lk_bdy .AND. lk_dynspg_ts  ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 
    189  
    190 !!$   Do we need a call to bdy_vol here?? 
    191       ! 
    192 # endif 
    193       ! 
    194142# if defined key_agrif 
    195143      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries 
    196144# endif 
    197 #endif 
    198  
     145      ! 
     146      CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries 
     147      CALL lbc_lnk( va, 'V', -1. )  
     148      ! 
     149# if defined key_bdy 
     150      !                                !* BDY open boundaries 
     151      IF( lk_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt ) 
     152      IF( lk_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, dyn3d_only=.true. ) 
     153 
     154!!$   Do we need a call to bdy_vol here?? 
     155      ! 
     156# endif 
     157      ! 
    199158      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics 
    200159         z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step  
     
    253212            ! (used as a now filtered scale factor until the swap) 
    254213            ! ---------------------------------------------------- 
    255             IF (lk_dynspg_ts.AND.ln_bt_fw) THEN 
    256                ! No asselin filtering on thicknesses if forward time splitting 
    257                   e3t_b(:,:,:) = e3t_n(:,:,:) 
     214            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting 
     215               e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 
    258216            ELSE 
    259                e3t_b(:,:,:) = e3t_n(:,:,:) + atfp * ( e3t_b(:,:,:) - 2._wp * e3t_n(:,:,:) + e3t_a(:,:,:) ) 
     217               DO jk = 1, jpkm1 
     218                  e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     219               END DO 
    260220               ! Add volume filter correction: compatibility with tracer advection scheme 
    261221               ! => time filter + conservation correction (only at the first level) 
    262                IF ( nn_isf == 0) THEN   ! if no ice shelf melting 
    263                   e3t_b(:,:,1) = e3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 
    264                                  &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
     222               IF( nn_isf == 0) THEN   ! if no ice shelf melting 
     223                  zcoef = atfp * rdt * r1_rau0 
     224                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * (  emp_b(:,:) - emp(:,:)  & 
     225                     &                                   - rnf_b(:,:) + rnf(:,:)  ) * tmask(:,:,1) 
    265226               ELSE                     ! if ice shelf melting 
    266                   DO jj = 1,jpj 
    267                      DO ji = 1,jpi 
     227                  zcoef = atfp * rdt * r1_rau0 
     228                  DO jj = 1, jpj 
     229                     DO ji = 1, jpi 
    268230                        jk = mikt(ji,jj) 
    269                         e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       & 
    270                                           &                      * ( (emp_b(ji,jj)    - emp(ji,jj)   ) & 
    271                                           &                        - (rnf_b(ji,jj)    - rnf(ji,jj)   ) & 
    272                                           &                        + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk) 
     231                        e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  & 
     232                           &                                         - rnf_b   (ji,jj) + rnf   (ji,jj)  & 
     233                           &                                         + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,jk) 
    273234                     END DO 
    274235                  END DO 
     
    276237            ENDIF 
    277238            ! 
    278             IF( ln_dynadv_vec ) THEN 
    279                ! Before scale factor at (u/v)-points 
    280                ! ----------------------------------- 
     239            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
     240               ! Before filtered scale factor at (u/v)-points 
    281241               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    282242               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
    283                ! Leap-Frog - Asselin filter and swap: applied on velocity 
    284                ! ----------------------------------- 
    285243               DO jk = 1, jpkm1 
    286244                  DO jj = 1, jpj 
     
    297255               END DO 
    298256               ! 
    299             ELSE 
    300                ! Temporary filtered scale factor at (u/v)-points (will become before scale factor) 
    301                !------------------------------------------------ 
     257            ELSE                          ! Asselin filter applied on thickness weighted velocity 
     258               ! 
     259               CALL wrk_alloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
     260               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 
    302261               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    303262               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
    304                ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 
    305                ! -----------------------------------             =========================== 
    306263               DO jk = 1, jpkm1 
    307264                  DO jj = 1, jpj 
    308265                     DO ji = 1, jpi                   
    309                         zue3a = ua(ji,jj,jk) * e3u_a(ji,jj,jk) 
    310                         zve3a = va(ji,jj,jk) * e3v_a(ji,jj,jk) 
    311                         zue3n = un(ji,jj,jk) * e3u_n(ji,jj,jk) 
    312                         zve3n = vn(ji,jj,jk) * e3v_n(ji,jj,jk) 
    313                         zue3b = ub(ji,jj,jk) * e3u_b(ji,jj,jk) 
    314                         zve3b = vb(ji,jj,jk) * e3v_b(ji,jj,jk) 
     266                        zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk) 
     267                        zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk) 
     268                        zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk) 
     269                        zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     270                        zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk) 
     271                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk) 
    315272                        ! 
    316273                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
     
    324281                  END DO 
    325282               END DO 
    326                e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor 
     283               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor 
    327284               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     285               ! 
     286               CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
    328287            ENDIF 
    329288            ! 
    330289         ENDIF 
    331290         ! 
    332          IF (lk_dynspg_ts.AND.ln_bt_fw) THEN 
     291         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN 
    333292            ! Revert "before" velocities to time split estimate 
    334293            ! Doing it here also means that asselin filter contribution is removed   
     
    364323      ENDIF 
    365324      ! 
    366       un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
    367       ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    368       DO jk = 1, jpkm1 
    369          DO jj = 1, jpj 
    370             DO ji = 1, jpi 
    371                un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    372                vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    373                ! 
    374                ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    375                vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    376             END DO 
    377          END DO 
     325      un_b(:,:) = e3u_a(:,:,jk) * un(:,:,1) * umask(:,:,1) 
     326      ub_b(:,:) = e3u_b(:,:,jk) * ub(:,:,1) * umask(:,:,1) 
     327      vn_b(:,:) = e3v_a(:,:,jk) * vn(:,:,1) * vmask(:,:,1) 
     328      vb_b(:,:) = e3v_b(:,:,jk) * vb(:,:,1) * vmask(:,:,1) 
     329      DO jk = 2, jpkm1 
     330         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(ji,jj,jk) 
     331         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(ji,jj,jk) 
     332         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(ji,jj,jk) 
     333         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(ji,jj,jk) 
    378334      END DO 
    379335      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
     
    382338      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    383339      ! 
     340      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
     341         CALL iom_put(  "ubar", un_b(:,:) ) 
     342         CALL iom_put(  "vbar", vn_b(:,:) ) 
     343      ENDIF 
    384344      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    385345         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
     
    391351         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    392352      !  
    393       CALL wrk_dealloc( jpi,jpj,jpk,  ze3u_f, ze3v_f, zua, zva ) 
    394       IF( lk_dynspg_ts )   CALL wrk_dealloc( jpi,jpj, zue, zve ) 
     353      IF( ln_dynspg_ts )   CALL wrk_dealloc( jpi,jpj,       zue, zve ) 
     354      IF( l_trddyn     )   CALL wrk_dealloc( jpi,jpj,jpk,   zua, zva ) 
    395355      ! 
    396356      IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt') 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r5845 r6004  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   dyn_spg     : update the dynamics trend with the lateral diffusion 
    12    !!   dyn_spg_ctl : initialization, namelist read, and parameters control 
     11   !!   dyn_spg     : update the dynamics trend with surface pressure gradient  
     12   !!   dyn_spg_init: initialization, namelist read, and parameters control 
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce            ! ocean dynamics and tracers variables 
     
    1818   USE sbc_oce        ! surface boundary condition: ocean 
    1919   USE sbcapr         ! surface boundary condition: atmospheric pressure 
    20    USE dynspg_oce     ! surface pressure gradient variables 
    2120   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine) 
    2221   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine) 
    23    USE dynspg_flt     ! surface pressure gradient     (dyn_spg_flt routine) 
    24    USE dynadv         ! dynamics: vector invariant versus flux form 
    25    USE dynhpg, ONLY: ln_dynhpg_imp 
    26    USE sbctide 
    27    USE updtide 
     22   USE sbctide        !  
     23   USE updtide        !  
    2824   USE trd_oce        ! trends: ocean variables 
    2925   USE trddyn         ! trend manager: dynamics 
     
    3228   USE in_out_manager ! I/O manager 
    3329   USE lib_mpp        ! MPP library 
    34    USE solver         ! solver initialization 
    3530   USE wrk_nemo       ! Memory Allocation 
    3631   USE timing         ! Timing 
    3732 
    38  
    3933   IMPLICIT NONE 
    4034   PRIVATE 
     
    4438 
    4539   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...  
     40 
     41   !                       ! Parameter to control the surface pressure gradient scheme 
     42   INTEGER, PARAMETER ::   np_TS  = 1   ! split-explicit time stepping (Time-Splitting) 
     43   INTEGER, PARAMETER ::   np_EXP = 0   !       explicit time stepping 
     44   INTEGER, PARAMETER ::   np_NO  =-1   ! no surface pressure gradient, no scheme 
    4645 
    4746   !! * Substitutions 
     
    5453CONTAINS 
    5554 
    56    SUBROUTINE dyn_spg( kt, kindic ) 
     55   SUBROUTINE dyn_spg( kt ) 
    5756      !!---------------------------------------------------------------------- 
    5857      !!                  ***  ROUTINE dyn_spg  *** 
    5958      !! 
    60       !! ** Purpose :   achieve the momentum time stepping by computing the 
    61       !!              last trend, the surface pressure gradient including the  
    62       !!              atmospheric pressure forcing (ln_apr_dyn=T), and performing 
    63       !!              the Leap-Frog integration. 
    64       !!gm              In the current version only the filtered solution provide 
    65       !!gm            the after velocity, in the 2 other (ua,va) are still the trends 
     59      !! ** Purpose :   compute surface pressure gradient including the  
     60      !!              atmospheric pressure forcing (ln_apr_dyn=T). 
    6661      !! 
    67       !! ** Method  :   Three schemes: 
    68       !!              - explicit computation      : the spg is evaluated at now 
    69       !!              - filtered computation      : the Roulet & madec (2000) technique is used 
    70       !!              - split-explicit computation: a time splitting technique is used 
     62      !! ** Method  :   Two schemes: 
     63      !!              - explicit       : the spg is evaluated at now 
     64      !!              - split-explicit : a time splitting technique is used 
    7165      !! 
    7266      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied  
     
    7872      !!---------------------------------------------------------------------- 
    7973      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    80       INTEGER, INTENT(  out) ::   kindic   ! solver flag 
    8174      ! 
    8275      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
     
    8881      IF( nn_timing == 1 )  CALL timing_start('dyn_spg') 
    8982      ! 
    90  
    91 !!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that  
    92 !!gm             they return the after velocity, not the trends (as in trazdf_imp...) 
    93 !!gm             In this case, change/simplify dynnxt 
    94  
    95  
    9683      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    9784         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
     
    9986         ztrdv(:,:,:) = va(:,:,:) 
    10087      ENDIF 
    101  
     88      ! 
    10289      IF(      ln_apr_dyn                                                &   ! atmos. pressure 
    103          .OR.  ( .NOT.lk_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) )   &   ! tide potential (no time slitting) 
     90         .OR.  ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) )   &   ! tide potential (no time slitting) 
    10491         .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice 
    10592         ! 
     
    11198         END DO          
    11299         ! 
    113          IF( ln_apr_dyn .AND. (.NOT. lk_dynspg_ts) ) THEN                    !==  Atmospheric pressure gradient (added later in time-split case) ==! 
     100         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==! 
    114101            zg_2 = grav * 0.5 
    115102            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh 
     
    124111         ! 
    125112         !                                    !==  tide potential forcing term  ==! 
    126          IF( .NOT.lk_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case 
     113         IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case 
    127114            ! 
    128115            CALL upd_tide( kt )                      ! update tide potential 
     
    152139         ENDIF 
    153140         ! 
    154          DO jk = 1, jpkm1                     !== Add all terms to the general trend 
     141         DO jk = 1, jpkm1                    !== Add all terms to the general trend 
    155142            DO jj = 2, jpjm1 
    156143               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    160147            END DO 
    161148         END DO     
    162           
     149         ! 
    163150!!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 
    164                
    165       ENDIF 
    166  
    167       SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend 
    168       !                                                      
    169       CASE (  0 )   ;   CALL dyn_spg_exp( kt )              ! explicit 
    170       CASE (  1 )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting 
    171       CASE (  2 )   ;   CALL dyn_spg_flt( kt, kindic )      ! filtered 
    172       !                                                     
     151         !     
     152      ENDIF 
     153      ! 
     154      SELECT CASE ( nspg )                   !== surface pressure gradient computed and add to the general trend ==! 
     155      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt )              ! explicit 
     156      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting 
    173157      END SELECT 
    174158      !                     
    175       IF( l_trddyn )   THEN                      ! save the surface pressure gradient trends for further diagnostics 
    176          SELECT CASE ( nspg ) 
    177          CASE ( 0, 1 ) 
    178             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    179             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    180          CASE( 2 ) 
    181             z2dt = 2. * rdt 
    182             IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    183             ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:) 
    184             ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 
    185          END SELECT 
     159      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
     160         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     161         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    186162         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    187          ! 
    188163         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
    189164      ENDIF 
    190       !                                          ! print mean trends (used for debugging) 
     165      !                                      ! print mean trends (used for debugging) 
    191166      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, & 
    192167         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     
    201176      !!                  ***  ROUTINE dyn_spg_init  *** 
    202177      !!                 
    203       !! ** Purpose :   Control the consistency between cpp options for  
     178      !! ** Purpose :   Control the consistency between namelist options for  
    204179      !!              surface pressure gradient schemes 
    205180      !!---------------------------------------------------------------------- 
    206       INTEGER ::   ioptio 
     181      INTEGER ::   ioptio, ios   ! local integers 
     182      ! 
     183      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   & 
     184      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   & 
     185      &                    nn_baro , rn_bt_cmax, nn_bt_flt 
    207186      !!---------------------------------------------------------------------- 
    208187      ! 
    209188      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init') 
    210189      ! 
    211       IF(lwp) THEN             ! Control print 
     190      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface 
     191      READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 
     192901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp ) 
     193      ! 
     194      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface 
     195      READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 
     196902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp ) 
     197      IF(lwm) WRITE ( numond, namdyn_spg ) 
     198      ! 
     199      IF(lwp) THEN             ! Namelist print 
    212200         WRITE(numout,*) 
    213201         WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 
    214202         WRITE(numout,*) '~~~~~~~~~~~' 
    215          WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp 
    216          WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts 
    217          WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt 
    218       ENDIF 
    219  
    220       IF( lk_dynspg_ts ) CALL dyn_spg_ts_init( nit000 ) 
    221       ! (do it now, to set nn_baro, used to allocate some arrays later on) 
    222       !                        ! allocate dyn_spg arrays 
    223       IF( lk_dynspg_ts ) THEN 
    224          IF( dynspg_oce_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays') 
    225          IF( dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays') 
    226          IF ((neuler/=0).AND.(ln_bt_fw)) CALL ts_rst( nit000, 'READ' ) 
    227       ENDIF 
    228  
    229       !                        ! Control of surface pressure gradient scheme options 
    230       ioptio = 0 
    231       IF(lk_dynspg_exp)   ioptio = ioptio + 1 
    232       IF(lk_dynspg_ts )   ioptio = ioptio + 1 
    233       IF(lk_dynspg_flt)   ioptio = ioptio + 1 
    234       ! 
    235       IF(  ioptio > 1  .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) )   & 
    236            &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' ) 
    237       IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav )   & 
    238            &   CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' ) 
    239       ! 
    240       IF( lk_dynspg_exp)   nspg =  0 
    241       IF( lk_dynspg_ts )   nspg =  1 
    242       IF( lk_dynspg_flt)   nspg =  2 
     203         WRITE(numout,*) '     Explicit free surface                  ln_dynspg_exp = ', ln_dynspg_exp 
     204         WRITE(numout,*) '     Free surface with time splitting       ln_dynspg_ts  = ', ln_dynspg_ts 
     205      ENDIF 
     206      !                          ! Control of surface pressure gradient scheme options 
     207      ;                              nspg =  np_NO    ;   ioptio = 0 
     208      IF( ln_dynspg_exp ) THEN   ;   nspg =  np_EXP   ;   ioptio = ioptio + 1   ;   ENDIF 
     209      IF( ln_dynspg_ts  ) THEN   ;   nspg =  np_TS    ;   ioptio = ioptio + 1   ;   ENDIF 
     210      ! 
     211      IF( ioptio  > 1 )   CALL ctl_stop( 'Choose only one surface pressure gradient scheme' ) 
     212      IF( ioptio == 0 )   CALL ctl_warn( 'NO surface pressure gradient trend in momentum Eqs.' ) 
     213      ! 
     214      IF( ln_dynspg_ts .AND. ln_isfcav )   CALL ctl_stop( ' dynspg_ts not tested with ice shelf cavity ' ) 
    243215      ! 
    244216      IF(lwp) THEN 
    245217         WRITE(numout,*) 
    246          IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface' 
    247          IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme' 
    248          IF( nspg ==  2 )   WRITE(numout,*) '     filtered free surface' 
    249       ENDIF 
    250  
    251 #if defined key_dynspg_flt 
    252       CALL solver_init( nit000 )   ! Elliptic solver initialisation 
    253 #endif 
    254       !               ! Control of hydrostatic pressure choice 
    255       IF( lk_dynspg_ts .AND. ln_dynhpg_imp )   CALL ctl_stop( 'Semi-implicit hpg not compatible with time splitting' ) 
     218         IF( nspg == np_EXP )   WRITE(numout,*) '     explicit free surface' 
     219         IF( nspg == np_TS )   WRITE(numout,*) '     free surface with time splitting scheme' 
     220         IF( nspg == np_NO  )   WRITE(numout,*) '     No surface surface pressure gradient trend in momentum Eqs.' 
     221      ENDIF 
     222      ! 
     223      IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation 
     224         CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on 
     225         IF( dyn_spg_ts_alloc() /= 0  )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays' ) 
     226         IF( neuler/=0 .AND. ln_bt_fw )   CALL ts_rst( nit000, 'READ' ) 
     227      ENDIF 
    256228      ! 
    257229      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init') 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r5866 r6004  
    22   !!====================================================================== 
    33   !!                   ***  MODULE  dynspg_exp  *** 
    4    !! Ocean dynamics:  surface pressure gradient trend 
     4   !! Ocean dynamics:  surface pressure gradient trend, explicit scheme 
    55   !!====================================================================== 
    66   !! History :  2.0  !  2005-11  (V. Garnier, G. Madec, L. Bessieres) Original code 
    77   !!            3.2  !  2009-06  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_dynspg_exp 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_dynspg_exp'                              explicit free surface 
     9 
    1210   !!---------------------------------------------------------------------- 
    1311   !!   dyn_spg_exp  : update the momentum trend with the surface  
     
    2725   USE timing          ! Timing 
    2826 
    29  
    3027   IMPLICIT NONE 
    3128   PRIVATE 
    3229 
    33    PUBLIC   dyn_spg_exp   ! routine called by step.F90 
     30   PUBLIC   dyn_spg_exp   ! routine called by dynspg.F90  
    3431 
    3532   !! * Substitutions 
     
    10097   END SUBROUTINE dyn_spg_exp 
    10198 
    102 #else 
    103    !!---------------------------------------------------------------------- 
    104    !!   Default case :   Empty module   No standart explicit free surface  
    105    !!---------------------------------------------------------------------- 
    106 CONTAINS 
    107    SUBROUTINE dyn_spg_exp( kt )       ! Empty routine 
    108       WRITE(*,*) 'dyn_spg_exp: You should not have seen this print! error?', kt 
    109    END SUBROUTINE dyn_spg_exp 
    110 #endif 
    111  
    11299   !!====================================================================== 
    113100END MODULE dynspg_exp 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5904 r6004  
    11MODULE dynspg_ts 
     2   !!====================================================================== 
     3   !!                   ***  MODULE  dynspg_ts  *** 
     4   !! Ocean dynamics:  surface pressure gradient trend, split-explicit scheme 
    25   !!====================================================================== 
    36   !! History :   1.0  ! 2004-12  (L. Bessieres, G. Madec)  Original code 
     
    1114   !!             3.5  ! 2013-07  (J. Chanut) Switch to Forward-backward time stepping 
    1215   !!             3.6  ! 2013-11  (A. Coward) Update for z-tilde compatibility 
     16   !!             3.7  ! 2015-11  (J. Chanut) free surface simplification 
    1317   !!--------------------------------------------------------------------- 
    14 #if defined key_dynspg_ts 
     18 
    1519   !!---------------------------------------------------------------------- 
    16    !!   'key_dynspg_ts'         split explicit free surface 
    17    !!---------------------------------------------------------------------- 
    18    !!   dyn_spg_ts  : compute surface pressure gradient trend using a time- 
    19    !!                 splitting scheme and add to the general trend  
     20   !!   dyn_spg_ts     : compute surface pressure gradient trend using a time-splitting scheme  
     21   !!   dyn_spg_ts_init: initialisation of the time-splitting scheme 
     22   !!   ts_wgt         : set time-splitting weights for temporal averaging (or not) 
     23   !!   ts_rst         : read/write time-splitting fields in restart file 
    2024   !!---------------------------------------------------------------------- 
    2125   USE oce             ! ocean dynamics and tracers 
    2226   USE dom_oce         ! ocean space and time domain 
    2327   USE sbc_oce         ! surface boundary condition: ocean 
     28   USE zdf_oce         ! Bottom friction coefts 
    2429   USE sbcisf          ! ice shelf variable (fwfisf) 
    25    USE dynspg_oce      ! surface pressure gradient variables 
     30   USE sbcapr          ! surface boundary condition: atmospheric pressure 
     31   USE dynadv    , ONLY: ln_dynadv_vec 
    2632   USE phycst          ! physical constants 
    2733   USE dynvor          ! vorticity term 
    2834   USE bdy_par         ! for lk_bdy 
    29    USE bdytides        ! open boundary condition data      
     35   USE bdytides        ! open boundary condition data 
    3036   USE bdydyn2d        ! open boundary conditions on barotropic variables 
    3137   USE sbctide         ! tides 
    3238   USE updtide         ! tide potential 
     39   ! 
     40   USE in_out_manager  ! I/O manager 
    3341   USE lib_mpp         ! distributed memory computing library 
    3442   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3543   USE prtctl          ! Print control 
    36    USE in_out_manager  ! I/O manager 
    3744   USE iom             ! IOM library 
    3845   USE restart         ! only for lrst_oce 
    39    USE zdf_oce         ! Bottom friction coefts 
    4046   USE wrk_nemo        ! Memory Allocation 
    4147   USE timing          ! Timing     
    42    USE sbcapr          ! surface boundary condition: atmospheric pressure 
    43    USE dynadv, ONLY: ln_dynadv_vec 
    4448#if defined key_agrif 
    4549   USE agrif_opa_interp ! agrif 
     
    6064   REAL(wp),SAVE :: rdtbt   ! Barotropic time step 
    6165 
    62    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: & 
    63                     wgtbtp1, &              ! Primary weights used for time filtering of barotropic variables 
    64                     wgtbtp2                 ! Secondary weights used for time filtering of barotropic variables 
    65  
    66    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          ! ff/h at F points 
    67    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   ! triad of coriolis parameter 
    68    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   ! (only used with een vorticity scheme) 
    69  
    70    ! Arrays below are saved to allow testing of the "no time averaging" option 
    71    ! If this option is not retained, these could be replaced by temporary arrays 
    72    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  sshbb_e, sshb_e, & ! Instantaneous barotropic arrays 
    73                                                    ubb_e, ub_e,     & 
    74                                                    vbb_e, vb_e 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields 
     67 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff/h at F points 
     69   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   !: triad of coriolis parameter 
     70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   !: (only used with een vorticity scheme) 
     71 
     72   !! Time filtered arrays at baroclinic time step: 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection vel. at "now" barocl. step 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b      !: Half step fluxes (ln_bt_fw=T) 
     75#if defined key_agrif 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b,  vb2_i_b   !: Half step time integrated fluxes  
     77#endif 
     78 
     79   !! Arrays at barotropic time step:                   ! bef before !   before   !    now     !   after    ! 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e    ,    ub_e    ,    un_e    ,    ua_e    !: u-external velocity 
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e    ,    vb_e    ,    vn_e    ,    va_e    !: v-external velocity 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e  ,    sshb_e  ,    sshn_e  ,    ssha_e  !: external ssh 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e                 !: external u-depth 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e                 !: external v-depth 
     85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e                !: inverse of u-depth 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e                !: inverse of v-depth 
    7587 
    7688   !! * Substitutions 
     
    8799      !!                  ***  routine dyn_spg_ts_alloc  *** 
    88100      !!---------------------------------------------------------------------- 
    89       INTEGER :: ierr(3) 
     101      INTEGER :: ierr(5) 
    90102      !!---------------------------------------------------------------------- 
    91103      ierr(:) = 0 
    92104      ! 
    93       ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 
    94          &      ub_e(jpi,jpj)  , vb_e(jpi,jpj)   , & 
    95          &      ubb_e(jpi,jpj) , vbb_e(jpi,jpj)  , STAT= ierr(1) ) 
    96          ! 
    97       ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 
    98       ! 
    99       IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &  
    100          &                          ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 
     105      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 
     106         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), & 
     107         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), & 
     108         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(1) ) 
     109         ! 
     110      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj)                , STAT=ierr(2) ) 
     111      ! 
     112      IF( ln_dynvor_een )   ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj)                 , &  
     113         &                            ftsw(jpi,jpj) , ftse(jpi,jpj)                 , STAT=ierr(3) ) 
     114         ! 
     115      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_adv(jpi,jpj), vn_adv(jpi,jpj)    , STAT=ierr(4) ) 
     116#if defined key_agrif 
     117      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT= ierr(5)) 
     118#endif 
    101119      ! 
    102120      dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 
     121      ! 
    103122      IF( lk_mpp                )   CALL mpp_sum( dyn_spg_ts_alloc ) 
    104       IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays') 
     123      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays') 
    105124      ! 
    106125   END FUNCTION dyn_spg_ts_alloc 
     
    110129      !!---------------------------------------------------------------------- 
    111130      !! 
    112       !! ** Purpose :    
    113       !!      -Compute the now trend due to the explicit time stepping 
    114       !!      of the quasi-linear barotropic system.  
     131      !! ** Purpose : - Compute the now trend due to the explicit time stepping 
     132      !!              of the quasi-linear barotropic system, and add it to the 
     133      !!              general momentum trend.  
    115134      !! 
    116       !! ** Method  :   
     135      !! ** Method  : - split-explicit schem (time splitting) : 
    117136      !!      Barotropic variables are advanced from internal time steps 
    118137      !!      "n"   to "n+1" if ln_bt_fw=T 
     
    128147      !!      continuity equation taken at the baroclinic time steps. This  
    129148      !!      ensures tracers conservation. 
    130       !!      -Update 3d trend (ua, va) with barotropic component. 
     149      !!      - (ua, va) momentum trend updated with barotropic component. 
    131150      !! 
    132       !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005:  
    133       !!              The regional oceanic modeling system (ROMS):  
    134       !!              a split-explicit, free-surface, 
    135       !!              topography-following-coordinate oceanic model.  
    136       !!              Ocean Modelling, 9, 347-404.  
     151      !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005.  
    137152      !!--------------------------------------------------------------------- 
    138153      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
     
    149164      REAL(wp) ::   za0, za1, za2, za3         !   -      - 
    150165      ! 
    151       REAL(wp), POINTER, DIMENSION(:,:) ::   zun_e, zvn_e, zsshp2_e 
    152       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 
    153       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_sum, zv_sum, zwx, zwy, zhdiv 
    154       REAL(wp), POINTER, DIMENSION(:,:) ::   zhup2_e, zhvp2_e, zhust_e, zhvst_e 
    155       REAL(wp), POINTER, DIMENSION(:,:) ::   zsshu_a, zsshv_a 
    156       REAL(wp), POINTER, DIMENSION(:,:) ::   zhf 
     166      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 
     167      REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 
     168      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv 
     169      REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 
     170      REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 
     171      REAL(wp), POINTER, DIMENSION(:,:) :: zhf 
    157172      !!---------------------------------------------------------------------- 
    158173      ! 
    159174      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_ts') 
    160175      ! 
     176      !                                         !* Allocate temporary arrays 
    161177      CALL wrk_alloc( jpi,jpj,   zsshp2_e, zhdiv ) 
    162       CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd, zun_e, zvn_e  ) 
    163       CALL wrk_alloc( jpi,jpj,   zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 
     178      CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd) 
     179      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc) 
    164180      CALL wrk_alloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e) 
    165       CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a ) 
     181      CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a                                   ) 
    166182      CALL wrk_alloc( jpi,jpj,   zhf ) 
    167183      ! 
     
    180196      ll_fw_start = .FALSE. 
    181197      !                                            ! time offset in steps for bdy data update 
    182       IF( .NOT.ln_bt_fw ) THEN   ;   noffset =-2*nn_baro 
    183       ELSE                       ;   noffset = 0  
     198      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro 
     199      ELSE                       ;   noffset =   0  
    184200      ENDIF 
    185201      ! 
     
    194210         ! 
    195211         IF( ln_bt_fw .OR. neuler == 0 ) THEN 
    196             ll_fw_start=.TRUE. 
    197             noffset = 0 
     212            ll_fw_start =.TRUE. 
     213            noffset     = 0 
    198214         ELSE 
    199             ll_fw_start=.FALSE. 
     215            ll_fw_start =.FALSE. 
    200216         ENDIF 
    201217         ! 
     
    212228      ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step 
    213229      ! 
    214       IF ( kt == nit000 .OR. .NOT.ln_linssh ) THEN 
    215          IF ( ln_dynvor_een ) THEN              !==  EEN scheme  ==! 
     230      IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN 
     231         IF( ln_dynvor_een ) THEN               !==  EEN scheme  ==! 
    216232            SELECT CASE( nn_een_e3f )              !* ff/e3 at F-point 
    217233            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     
    219235                  DO ji = 1, jpim1 
    220236                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    221                         &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) / 4._wp   
     237                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
    222238                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 
    223239                  END DO 
     
    407423      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 
    408424      !        
    409       IF (ln_bt_fw) THEN                        ! Add wind forcing 
     425      IF( ln_bt_fw ) THEN                        ! Add wind forcing 
    410426         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 
    411427         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 
     
    477493      ! 
    478494      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    479          sshn_e(:,:) = sshn(:,:)             
    480          zun_e (:,:) = un_b(:,:)             
    481          zvn_e (:,:) = vn_b(:,:) 
     495         sshn_e(:,:) =    sshn(:,:)             
     496         un_e  (:,:) =    un_b(:,:)             
     497         vn_e  (:,:) =    vn_b(:,:) 
    482498         ! 
    483499         hu_e  (:,:) =    hu_n(:,:)        
     
    486502         hvr_e (:,:) = r1_hv_n(:,:) 
    487503      ELSE                                ! CENTRED integration: start from BEFORE fields 
    488          sshn_e(:,:) = sshb(:,:) 
    489          zun_e (:,:) = ub_b(:,:)          
    490          zvn_e (:,:) = vb_b(:,:) 
     504         sshn_e(:,:) =    sshb(:,:) 
     505         un_e  (:,:) =    ub_b(:,:)          
     506         vn_e  (:,:) =    vb_b(:,:) 
    491507         ! 
    492508         hu_e  (:,:) =    hu_b(:,:)        
     
    502518      va_b  (:,:) = 0._wp 
    503519      ssha  (:,:) = 0._wp       ! Sum for after averaged sea level 
    504       zu_sum(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
    505       zv_sum(:,:) = 0._wp 
     520      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
     521      vn_adv(:,:) = 0._wp 
    506522      !                                             ! ==================== ! 
    507523      DO jn = 1, icycle                             !  sub-time-step loop  ! 
     
    511527         ! Update only tidal forcing at open boundaries 
    512528#if defined key_tide 
    513          IF ( lk_bdy .AND. lk_tide )      CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 
    514          IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide     ( kt, kit=jn, koffset=noffset ) 
     529         IF( lk_bdy      .AND. lk_tide )   CALL bdy_dta_tides( kt, kit=jn, time_offset= noffset+1 ) 
     530         IF( ln_tide_pot .AND. lk_tide )   CALL upd_tide     ( kt, kit=jn, time_offset= noffset  ) 
    515531#endif 
    516532         ! 
     
    527543 
    528544         ! Extrapolate barotropic velocities at step jit+0.5: 
    529          ua_e(:,:) = za1 * zun_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 
    530          va_e(:,:) = za1 * zvn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 
     545         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 
     546         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 
    531547 
    532548         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only) 
     
    589605         ! Sum over sub-time-steps to compute advective velocities 
    590606         za2 = wgtbtp2(jn) 
    591          zu_sum(:,:) = zu_sum(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 
    592          zv_sum(:,:) = zv_sum(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 
     607         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 
     608         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 
    593609         ! 
    594610         ! Set next sea level: 
     
    648664         ! 
    649665         ! Compute associated depths at U and V points: 
    650          IF( .NOT.( ln_dynadv_vec .OR. ln_linssh ) ) THEN   !* Vector form 
     666         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN   !* Vector form 
    651667            !                                         
    652668            DO jj = 2, jpjm1                             
     
    671687         ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
    672688         ! 
    673          IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      !==  energy conserving or mixed scheme  ==! 
     689         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==! 
    674690            DO jj = 2, jpjm1 
    675691               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    683699            END DO 
    684700            ! 
    685          ELSEIF ( ln_dynvor_ens ) THEN                    !==  enstrophy conserving scheme  ==! 
     701         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==! 
    686702            DO jj = 2, jpjm1 
    687703               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    695711            END DO 
    696712            ! 
    697          ELSEIF ( ln_dynvor_een ) THEN !==  energy and enstrophy conserving scheme  ==! 
     713         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==! 
    698714            DO jj = 2, jpjm1 
    699715               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    724740         ! 
    725741         ! Add bottom stresses: 
    726          zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * zun_e(:,:) * hur_e(:,:) 
    727          zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * zvn_e(:,:) * hvr_e(:,:) 
     742         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 
     743         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
    728744         ! 
    729745         ! Surface pressure trend: 
     
    742758            DO jj = 2, jpjm1 
    743759               DO ji = fs_2, fs_jpim1   ! vector opt. 
    744                   ua_e(ji,jj) = (                                zun_e(ji,jj)   &  
    745                             &     + rdtbt * (                      zwx(ji,jj)   & 
    746                             &                                 + zu_trd(ji,jj)   & 
    747                             &                                 + zu_frc(ji,jj) ) &  
    748                             &   ) * umask(ji,jj,1) 
    749  
    750                   va_e(ji,jj) = (                                zvn_e(ji,jj)   & 
    751                             &     + rdtbt * (                      zwy(ji,jj)   & 
    752                             &                                 + zv_trd(ji,jj)   & 
    753                             &                                 + zv_frc(ji,jj) ) & 
    754                             &   ) * vmask(ji,jj,1) 
    755                END DO 
    756             END DO 
    757  
     760                  ua_e(ji,jj) = (                                 un_e(ji,jj)    &  
     761                     &            + rdtbt * (                      zwx(ji,jj)    & 
     762                     &                                        + zu_trd(ji,jj)    & 
     763                     &                                        + zu_frc(ji,jj) )  ) * umask(ji,jj,1) 
     764                     ! 
     765                  va_e(ji,jj) = (                                 vn_e(ji,jj)    & 
     766                     &            + rdtbt * (                      zwy(ji,jj)    & 
     767                     &                                        + zv_trd(ji,jj)    & 
     768                     &                                        + zv_frc(ji,jj) )  ) * vmask(ji,jj,1) 
     769               END DO 
     770            END DO 
     771            ! 
    758772         ELSE                                      !* Flux form 
    759773            DO jj = 2, jpjm1 
    760774               DO ji = fs_2, fs_jpim1   ! vector opt. 
    761  
    762                   zhura = umask(ji,jj,1)/(hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - umask(ji,jj,1)) 
    763                   zhvra = vmask(ji,jj,1)/(hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1)) 
    764  
    765                   ua_e(ji,jj) = (                hu_e(ji,jj)  *  zun_e(ji,jj)   &  
    766                             &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
    767                             &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   & 
    768                             &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) & 
    769                             &   ) * zhura 
    770  
    771                   va_e(ji,jj) = (                hv_e(ji,jj)  *  zvn_e(ji,jj)   & 
    772                             &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
    773                             &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   & 
    774                             &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) & 
    775                             &   ) * zhvra 
     775                  zhura = umask(ji,jj,1) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - umask(ji,jj,1) ) 
     776                  zhvra = vmask(ji,jj,1) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1) ) 
     777                  ! 
     778                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)    &  
     779                     &            + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)    &  
     780                     &                      + zhup2_e(ji,jj)  * zu_trd(ji,jj)    & 
     781                     &                      +    hu_n(ji,jj)  * zu_frc(ji,jj) )  ) * zhura 
     782                     ! 
     783                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)    & 
     784                     &            + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)    & 
     785                     &                      + zhvp2_e(ji,jj)  * zv_trd(ji,jj)    & 
     786                     &                      +    hv_n(ji,jj)  * zv_frc(ji,jj) )  ) * zhvra 
    776787               END DO 
    777788            END DO 
     
    779790         ! 
    780791         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only) 
    781             !                                          !  ----------------------------------------------         
    782792            hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 
    783793            hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 
     
    787797         ENDIF 
    788798         !                                             !* domain lateral boundary 
    789          !                                             !  ----------------------- 
    790          ! 
    791799         CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 
    792800         ! 
    793801#if defined key_bdy   
    794802         !                                                 ! open boundaries 
    795          IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e ) 
     803         IF( lk_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 
    796804#endif 
    797805#if defined key_agrif                                                            
     
    801809         !                                             !  ---- 
    802810         ubb_e  (:,:) = ub_e  (:,:) 
    803          ub_e   (:,:) = zun_e (:,:) 
    804          zun_e  (:,:) = ua_e  (:,:) 
     811         ub_e   (:,:) = un_e (:,:) 
     812         un_e   (:,:) = ua_e  (:,:) 
    805813         ! 
    806814         vbb_e  (:,:) = vb_e  (:,:) 
    807          vb_e   (:,:) = zvn_e (:,:) 
    808          zvn_e  (:,:) = va_e  (:,:) 
     815         vb_e   (:,:) = vn_e (:,:) 
     816         vn_e   (:,:) = va_e  (:,:) 
    809817         ! 
    810818         sshbb_e(:,:) = sshb_e(:,:) 
     
    831839      ! ----------------------------------------------------------------------------- 
    832840      ! 
    833       ! At this stage ssha holds a time averaged value 
    834       !                                                ! Sea Surface Height at u-,v- and f-points 
    835       IF( .NOT.ln_linssh ) THEN                        ! (required only in non-linear free surface case) 
     841      ! Set advection velocity correction: 
     842      zwx(:,:) = un_adv(:,:) 
     843      zwy(:,:) = vn_adv(:,:) 
     844      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
     845         un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 
     846         vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 
     847      ELSE 
     848         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 
     849         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 
     850      END IF 
     851 
     852      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
     853         ub2_b(:,:) = zwx(:,:) 
     854         vb2_b(:,:) = zwy(:,:) 
     855      ENDIF 
     856      ! 
     857      ! Update barotropic trend: 
     858      IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
     859         DO jk=1,jpkm1 
     860            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 
     861            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 
     862         END DO 
     863      ELSE 
     864         ! At this stage, ssha has been corrected: compute new depths at velocity points 
    836865         DO jj = 1, jpjm1 
    837866            DO ji = 1, jpim1      ! NO Vector Opt. 
     
    845874         END DO 
    846875         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    847       ENDIF 
    848       ! 
    849       ! Set advection velocity correction: 
    850       IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
    851          un_adv(:,:) = zu_sum(:,:) * r1_hu_n(:,:) 
    852          vn_adv(:,:) = zv_sum(:,:) * r1_hv_n(:,:) 
    853       ELSE 
    854          un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:) ) * r1_hu_n(:,:) 
    855          vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:) ) * r1_hv_n(:,:) 
    856       END IF 
    857  
    858       IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
    859          ub2_b(:,:) = zu_sum(:,:) 
    860          vb2_b(:,:) = zv_sum(:,:) 
    861       ENDIF 
    862       ! 
    863       ! Update barotropic trend: 
    864       IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
    865          DO jk=1,jpkm1 
    866             ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 
    867             va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 
    868          END DO 
    869       ELSE 
     876         ! 
    870877         DO jk=1,jpkm1 
    871878            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 
     
    883890         ! 
    884891      END DO 
     892      ! 
     893      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current 
     894      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic i-current 
    885895      ! 
    886896#if defined key_agrif 
     
    898908         vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 
    899909      ENDIF 
    900       ! 
    901       ! 
    902910#endif       
    903       ! 
    904911      !                                   !* write time-spliting arrays in the restart 
    905912      IF( lrst_oce .AND.ln_bt_fw )   CALL ts_rst( kt, 'WRITE' ) 
    906913      ! 
    907914      CALL wrk_dealloc( jpi,jpj,   zsshp2_e, zhdiv ) 
    908       CALL wrk_dealloc( jpi,jpj,   zu_trd, zv_trd, zun_e, zvn_e ) 
    909       CALL wrk_dealloc( jpi,jpj,   zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 
     915      CALL wrk_dealloc( jpi,jpj,   zu_trd, zv_trd ) 
     916      CALL wrk_dealloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc ) 
    910917      CALL wrk_dealloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 
    911       CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a ) 
     918      CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a                                   ) 
    912919      CALL wrk_dealloc( jpi,jpj,   zhf ) 
    913920      ! 
     
    9941001   END SUBROUTINE ts_wgt 
    9951002 
     1003 
    9961004   SUBROUTINE ts_rst( kt, cdrw ) 
    9971005      !!--------------------------------------------------------------------- 
     
    10471055   END SUBROUTINE ts_rst 
    10481056 
    1049    SUBROUTINE dyn_spg_ts_init( kt ) 
     1057 
     1058   SUBROUTINE dyn_spg_ts_init 
    10501059      !!--------------------------------------------------------------------- 
    10511060      !!                   ***  ROUTINE dyn_spg_ts_init  *** 
     
    10531062      !! ** Purpose : Set time splitting options 
    10541063      !!---------------------------------------------------------------------- 
    1055       INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    1056       ! 
    1057       INTEGER  :: ji ,jj 
    1058       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    1059       REAL(wp) :: zxr2, zyr2, zcmax 
    1060       REAL(wp), POINTER, DIMENSION(:,:) :: zcu 
    1061       !! 
    1062       NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, & 
    1063       &                  nn_baro, rn_bt_cmax, nn_bt_flt 
     1064      INTEGER  ::   ji ,jj              ! dummy loop indices 
     1065      REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar 
     1066      REAL(wp), POINTER, DIMENSION(:,:) ::   zcu 
    10641067      !!---------------------------------------------------------------------- 
    10651068      ! 
    1066       REWIND( numnam_ref )              ! Namelist namsplit in reference namelist : time splitting parameters 
    1067       READ  ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901) 
    1068 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp ) 
    1069  
    1070       REWIND( numnam_cfg )              ! Namelist namsplit in configuration namelist : time splitting parameters 
    1071       READ  ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 
    1072 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 
    1073       IF(lwm) WRITE ( numond, namsplit ) 
    1074       ! 
    1075       !         ! Max courant number for ext. grav. waves 
    1076       ! 
    1077       CALL wrk_alloc( jpi, jpj, zcu ) 
    1078       ! 
    1079       IF( .NOT.ln_linssh ) THEN  
    1080          DO jj = 1, jpj 
    1081             DO ji =1, jpi 
    1082                zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    1083                zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
    1084                zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 
    1085             END DO 
    1086          END DO 
    1087       ELSE 
    1088 !!gm  BUG ??  restartability issue if ssh changes are large.... 
    1089 !!gm          We should just test this with ht_0 only, no? 
    1090          DO jj = 1, jpj 
    1091             DO ji =1, jpi 
    1092                zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    1093                zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    1094                zcu(ji,jj) = SQRT( grav * ht_n(ji,jj) * (zxr2 + zyr2) ) 
    1095             END DO 
    1096          END DO 
    1097       ENDIF 
    1098  
     1069      ! Max courant number for ext. grav. waves 
     1070      ! 
     1071      CALL wrk_alloc( jpi,jpj,   zcu ) 
     1072      ! 
     1073      DO jj = 1, jpj 
     1074         DO ji =1, jpi 
     1075            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
     1076            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
     1077            zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 
     1078         END DO 
     1079      END DO 
     1080      ! 
    10991081      zcmax = MAXVAL( zcu(:,:) ) 
    11001082      IF( lk_mpp )   CALL mpp_max( zcmax ) 
    11011083 
    11021084      ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 
    1103       IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 
     1085      IF( ln_bt_auto )  nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 
    11041086       
    11051087      rdtbt = rdt / REAL( nn_baro , wp ) 
     
    11091091      IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface' 
    11101092      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    1111       IF( ln_bt_nn_auto ) THEN 
    1112          IF(lwp) WRITE(numout,*) '     ln_ts_nn_auto=.true. Automatically set nn_baro ' 
     1093      IF( ln_bt_auto ) THEN 
     1094         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.true. Automatically set nn_baro ' 
    11131095         IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax 
    11141096      ELSE 
    1115          IF(lwp) WRITE(numout,*) '     ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 
     1097         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist ' 
    11161098      ENDIF 
    11171099 
     
    11311113#if defined key_agrif 
    11321114      ! Restrict the use of Agrif to the forward case only 
    1133       IF ((.NOT.ln_bt_fw ).AND.(.NOT.Agrif_Root())) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 
     1115      IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() )  CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 
    11341116#endif 
    11351117      ! 
    11361118      IF(lwp) WRITE(numout,*)    '     Time filter choice, nn_bt_flt: ', nn_bt_flt 
    11371119      SELECT CASE ( nn_bt_flt ) 
    1138            CASE( 0 )  ;   IF(lwp) WRITE(numout,*) '           Dirac' 
    1139            CASE( 1 )  ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro' 
    1140            CASE( 2 )  ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro'  
    1141            CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 
     1120         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac' 
     1121         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro' 
     1122         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro'  
     1123         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 
    11421124      END SELECT 
    11431125      ! 
     
    11471129      IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax 
    11481130      ! 
    1149       IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN 
     1131      IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN 
    11501132         CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) 
    11511133      ENDIF 
    1152       IF ( zcmax>0.9_wp ) THEN 
     1134      IF( zcmax>0.9_wp ) THEN 
    11531135         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )           
    11541136      ENDIF 
    11551137      ! 
    1156       CALL wrk_dealloc( jpi, jpj, zcu ) 
     1138      CALL wrk_dealloc( jpi,jpj,  zcu ) 
    11571139      ! 
    11581140   END SUBROUTINE dyn_spg_ts_init 
    11591141 
    1160 #else 
    1161    !!--------------------------------------------------------------------------- 
    1162    !!   Default case :   Empty module   No split explicit free surface 
    1163    !!--------------------------------------------------------------------------- 
    1164 CONTAINS 
    1165    INTEGER FUNCTION dyn_spg_ts_alloc()    ! Dummy function 
    1166       dyn_spg_ts_alloc = 0 
    1167    END FUNCTION dyn_spg_ts_alloc 
    1168    SUBROUTINE dyn_spg_ts( kt )            ! Empty routine 
    1169       INTEGER, INTENT(in) :: kt 
    1170       WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt 
    1171    END SUBROUTINE dyn_spg_ts 
    1172    SUBROUTINE ts_rst( kt, cdrw )          ! Empty routine 
    1173       INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    1174       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    1175       WRITE(*,*) 'ts_rst    : You should not have seen this print! error?', kt, cdrw 
    1176    END SUBROUTINE ts_rst   
    1177    SUBROUTINE dyn_spg_ts_init( kt )       ! Empty routine 
    1178       INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    1179       WRITE(*,*) 'dyn_spg_ts_init   : You should not have seen this print! error?', kt 
    1180    END SUBROUTINE dyn_spg_ts_init 
    1181 #endif 
    1182     
    11831142   !!====================================================================== 
    11841143END MODULE dynspg_ts 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r5845 r6004  
    413413         DO jj = 2, jpjm1 
    414414            DO ji = fs_2, fs_jpim1   ! vector opt. 
    415                zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
    416                   &                          + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
    417                zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
    418                   &                          + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
     415               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  & 
     416                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
     417               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  & 
     418                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    419419               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    420420               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    481481            DO jj = 1, jpjm1 
    482482               DO ji = 1, fs_jpim1   ! vector opt. 
    483                   ze3  = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    484                      &   + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    485                   IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4.0_wp / ze3 
    486                   ELSE                      ;   z1_e3f(ji,jj) = 0.0_wp 
     483                  ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     484                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
     485                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3 
     486                  ELSE                      ;   z1_e3f(ji,jj) = 0._wp 
    487487                  ENDIF 
    488488               END DO 
     
    491491            DO jj = 1, jpjm1 
    492492               DO ji = 1, fs_jpim1   ! vector opt. 
    493                   ze3  = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    494                      &   + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    495                   zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    496                      &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
     493                  ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     494                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
     495                  zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
     496                     &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
    497497                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3 
    498                   ELSE                      ;   z1_e3f(ji,jj) = 0.0_wp 
     498                  ELSE                      ;   z1_e3f(ji,jj) = 0._wp 
    499499                  ENDIF 
    500500               END DO 
     
    546546         END SELECT 
    547547         ! 
     548         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
     549            DO jj = 1, jpjm1 
     550               DO ji = 1, fs_jpim1   ! vector opt. 
     551                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
     552               END DO 
     553            END DO 
     554         ENDIF 
     555         ! 
    548556         CALL lbc_lnk( zwz, 'F', 1. ) 
    549          ! 
    550          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    551             DO jj = 1, jpjm1 
    552                DO ji = 1, fs_jpim1   ! vector opt. 
    553                   zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
    554                END DO 
    555             END DO 
    556          ENDIF 
    557557         ! 
    558558         !                                   !==  horizontal fluxes  ==! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r5845 r6004  
    120120            DO ji = fs_2, fs_jpim1       ! vector opt. 
    121121               !                         ! vertical momentum advective trends 
    122                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    123                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
     122               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     123               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    124124               !                         ! add the trends to the general momentum trends 
    125125               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     
    251251               DO ji = fs_2, fs_jpim1       ! vector opt. 
    252252                  !                         ! vertical momentum advective trends 
    253                   zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    254                   zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
     253                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     254                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    255255                  zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 
    256256                  zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r5845 r6004  
    88   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
     10   !!            3.7  !  2015-11  (J. Chanut) output velocities instead of trends 
    1011   !!---------------------------------------------------------------------- 
    1112 
    1213   !!---------------------------------------------------------------------- 
    13    !!   dyn_zdf_exp  : update the momentum trend with the vertical diffu- 
    14    !!                  sion using an explicit time-stepping scheme. 
     14   !!   dyn_zdf_exp   : update the momentum trend with the vertical diffusion using a split-explicit scheme 
     15   !!                   and perform the Leap-Frog time integration. 
    1516   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE phycst          ! physical constants 
    19    USE zdf_oce         ! ocean vertical physics 
    20    USE sbc_oce         ! surface boundary condition: ocean 
    21    USE lib_mpp         ! MPP library 
    22    USE in_out_manager  ! I/O manager 
    23    USE lib_mpp         ! MPP library 
    24    USE wrk_nemo        ! Memory Allocation 
    25    USE timing          ! Timing 
    26  
     17   USE oce            ! ocean dynamics and tracers 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE phycst         ! physical constants 
     20   USE zdf_oce        ! ocean vertical physics 
     21   USE dynadv   , ONLY: ln_dynadv_vec ! Momentum advection form 
     22   USE sbc_oce        ! surface boundary condition: ocean 
     23   ! 
     24   USE in_out_manager ! I/O manager 
     25   USE lib_mpp        ! MPP library 
     26   USE wrk_nemo       ! Memory Allocation 
     27   USE timing         ! Timing 
    2728 
    2829   IMPLICIT NONE 
     
    3435#  include "vectopt_loop_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     37   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    3738   !! $Id$ 
    3839   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4546      !!                    
    4647      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion 
     48      !!              and perform the Leap-Frog time stepping. 
    4749      !! 
    48       !! ** Method  :   Explicit forward time stepping with a time splitting 
    49       !!      technique. The vertical diffusion of momentum is given by: 
     50      !! ** Method  : - Split-explicit forward time stepping. 
     51      !!      The vertical mixing of momentum is given by: 
    5052      !!         diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) ) 
    5153      !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2) 
     
    5355      !!      Add this trend to the general trend ua : 
    5456      !!         ua = ua + dz( avmu dz(u) ) 
     57      !!              - Leap-Frog time stepping (Asselin filter will be applied in dyn_nxt)  
     58      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf. 
     59      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise 
    5560      !! 
    56       !! ** Action : - Update (ua,va) with the vertical diffusive trend 
     61      !! ** Action : - (ua,va) after velocity 
    5762      !!--------------------------------------------------------------------- 
    5863      INTEGER , INTENT(in) ::   kt     ! ocean time-step index 
    5964      REAL(wp), INTENT(in) ::   p2dt   ! time-step  
    6065      ! 
    61       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     66      INTEGER  ::   ji, jj, jk, jl     ! dummy loop indices 
    6267      REAL(wp) ::   zlavmr, zua, zva   ! local scalars 
    6368      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww 
    6469      !!---------------------------------------------------------------------- 
    6570      ! 
    66       IF( nn_timing == 1 )  CALL timing_start('dyn_zdf_exp') 
     71      IF( nn_timing == 1 )   CALL timing_start('dyn_zdf_exp') 
    6772      ! 
    68       CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, zww )  
     73      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, zww )  
    6974      ! 
    7075      IF( kt == nit000 .AND. lwp ) THEN 
     
    7378         WRITE(numout,*) '~~~~~~~~~~~ ' 
    7479      ENDIF 
    75  
     80      ! 
     81      !                 !==  vertical mixing trend  ==! 
     82      ! 
    7683      zlavmr = 1. / REAL( nn_zdfexp ) 
    77  
    78  
    79       DO jj = 2, jpjm1                 ! Surface boundary condition 
     84      ! 
     85      DO jj = 2, jpjm1           ! Surface boundary condition 
    8086         DO ji = 2, jpim1 
    8187            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0 
     
    8389         END DO   
    8490      END DO   
    85       DO jk = 1, jpk                   ! Initialization of x, z and contingently trends array 
     91      DO jk = 1, jpk             ! Initialization of x, z and contingently trends array 
    8692         DO jj = 2, jpjm1  
    8793            DO ji = 2, jpim1 
     
    9298      END DO   
    9399      ! 
    94       DO jl = 1, nn_zdfexp             ! Time splitting loop 
     100      DO jl = 1, nn_zdfexp       ! Time splitting loop 
    95101         ! 
    96          DO jk = 2, jpk                      ! First vertical derivative 
     102         DO jk = 2, jpk                ! First vertical derivative 
    97103            DO jj = 2, jpjm1  
    98104               DO ji = 2, jpim1 
     
    102108            END DO   
    103109         END DO   
    104          DO jk = 1, jpkm1                    ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp 
     110         DO jk = 1, jpkm1              ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp 
    105111            DO jj = 2, jpjm1  
    106112               DO ji = 2, jpim1 
     
    115121            END DO   
    116122         END DO   
    117          ! 
    118       END DO                           ! End of time splitting 
     123      END DO                     ! End of time splitting 
    119124      ! 
    120       CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, zww )  
    121125      ! 
    122       IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_exp') 
     126      !                 !==  Leap-Frog time integration  ==! 
     127      ! 
     128      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
     129         DO jk = 1, jpkm1 
     130            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 
     131            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 
     132         END DO 
     133      ELSE                                      ! applied on thickness weighted velocity 
     134         DO jk = 1, jpkm1 
     135            ua(:,:,jk) = (          e3u_b(:,:,jk) * ub(:,:,jk)    & 
     136               &           + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
     137            va(:,:,jk) = (          e3v_b(:,:,jk) * vb(:,:,jk)    & 
     138               &           + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
     139         END DO 
     140      ENDIF 
     141      ! 
     142      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, zww )  
     143      ! 
     144      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf_exp') 
    123145      ! 
    124146   END SUBROUTINE dyn_zdf_exp 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r5866 r6004  
    22   !!====================================================================== 
    33   !!                    ***  MODULE  dynzdf_imp  *** 
    4    !! Ocean dynamics:  vertical component(s) of the momentum mixing trend 
     4   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend, implicit scheme 
    55   !!====================================================================== 
    66   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
     
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   dyn_zdf_imp  : update the momentum trend with the vertical diffusion using a implicit time-stepping 
    15    !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE domvvl          ! variable volume 
    19    USE sbc_oce         ! surface boundary condition: ocean 
    20    USE zdf_oce         ! ocean vertical physics 
    21    USE phycst          ! physical constants 
    22    USE in_out_manager  ! I/O manager 
    23    USE lib_mpp         ! MPP library 
    24    USE zdfbfr          ! Bottom friction setup 
    25    USE wrk_nemo        ! Memory Allocation 
    26    USE timing          ! Timing 
    27    USE dynadv          ! dynamics: vector invariant versus flux form 
    28    USE dynspg_oce, ONLY: lk_dynspg_ts 
     14   !!   dyn_zdf_imp   : compute the vertical diffusion using a implicit scheme 
     15   !!                   together with the Leap-Frog time integration. 
     16   !!---------------------------------------------------------------------- 
     17   USE oce            ! ocean dynamics and tracers 
     18   USE phycst         ! physical constants 
     19   USE dom_oce        ! ocean space and time domain 
     20   USE domvvl         ! variable volume 
     21   USE sbc_oce        ! surface boundary condition: ocean 
     22   USE dynadv   , ONLY: ln_dynadv_vec ! Momentum advection form 
     23   USE zdf_oce        ! ocean vertical physics 
     24   USE zdfbfr         ! Bottom friction setup 
     25   ! 
     26   USE in_out_manager ! I/O manager 
     27   USE lib_mpp        ! MPP library 
     28   USE wrk_nemo       ! Memory Allocation 
     29   USE timing         ! Timing 
    2930 
    3031   IMPLICIT NONE 
     
    3334   PUBLIC   dyn_zdf_imp   ! called by step.F90 
    3435 
    35    REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if ln_linssh=F, =0 otherwise  
     36   REAL(wp) ::  r_vvl     ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise  
    3637 
    3738   !! * Substitutions 
     
    4950      !!                    
    5051      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion 
    51       !!      and the surface forcing, and add it to the general trend of  
    52       !!      the momentum equations. 
     52      !!              together with the Leap-Frog time stepping using an  
     53      !!              implicit scheme. 
    5354      !! 
    54       !! ** Method  :   The vertical momentum mixing trend is given by : 
    55       !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) ) 
    56       !!      backward time stepping 
    57       !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2) 
    58       !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F) 
    59       !!      Add this trend to the general trend ua : 
    60       !!         ua = ua + dz( avmu dz(u) ) 
     55      !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing 
     56      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf. 
     57      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise 
     58      !!               - update the after velocity with the implicit vertical mixing. 
     59      !!      This requires to solver the following system:  
     60      !!         ua = ua + 1/e3u_a dk+1[ avmu / e3uw_a dk[ua] ] 
     61      !!      with the following surface/top/bottom boundary condition: 
     62      !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2) 
     63      !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfbfr.F) 
    6164      !! 
    62       !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend. 
     65      !! ** Action :   (ua,va) after velocity  
    6366      !!--------------------------------------------------------------------- 
    6467      INTEGER , INTENT(in) ::  kt     ! ocean time-step index 
    6568      REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step 
    66       !! 
    67       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    68       INTEGER  ::   ikbu, ikbv   ! local integers 
    69       REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
    70       REAL(wp) ::   ze3ua, ze3va 
     69      ! 
     70      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     71      INTEGER  ::   ikbu, ikbv    ! local integers 
     72      REAL(wp) ::   zzwi, ze3ua   ! local scalars 
     73      REAL(wp) ::   zzws, ze3va   !   -      - 
    7174      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws 
    7275      !!---------------------------------------------------------------------- 
     
    8184         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
    8285         ! 
    83          IF( .NOT.ln_linssh ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator 
    84          ELSE                        ;    r_vvl = 0._wp        
     86         If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator 
     87         ELSE                   ;    r_vvl = 1._wp 
    8588         ENDIF 
    8689      ENDIF 
    87  
    88       ! 0. Local constant initialization 
    89       ! -------------------------------- 
    90       z1_p2dt = 1._wp / p2dt      ! inverse of the timestep 
    91  
    92       ! 1. Apply semi-implicit bottom friction 
    93       ! -------------------------------------- 
     90      ! 
     91      !              !==  Time step dynamics  ==! 
     92      ! 
     93      IF( ln_dynadv_vec .OR. ln_linssh ) THEN      ! applied on velocity 
     94         DO jk = 1, jpkm1 
     95            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 
     96            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 
     97         END DO 
     98      ELSE                                         ! applied on thickness weighted velocity 
     99         DO jk = 1, jpkm1 
     100            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  & 
     101               &          + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
     102            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  & 
     103               &          + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
     104         END DO 
     105      ENDIF 
     106      ! 
     107      !              !==  Apply semi-implicit bottom friction  ==! 
     108      ! 
    94109      ! Only needed for semi-implicit bottom friction setup. The explicit 
    95110      ! bottom friction has been included in "u(v)a" which act as the R.H.S 
    96111      ! column vector of the tri-diagonal matrix equation 
    97112      ! 
    98  
    99113      IF( ln_bfrimp ) THEN 
    100114         DO jj = 2, jpjm1 
     
    111125                  ikbu = miku(ji,jj)       ! ocean top level at u- and v-points  
    112126                  ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
    113                   IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu) 
    114                   IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv) 
     127                  IF( ikbu >= 2 )  avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu) 
     128                  IF( ikbv >= 2 )  avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv) 
    115129               END DO 
    116130            END DO 
    117131         END IF 
    118132      ENDIF 
    119  
    120 #if defined key_dynspg_ts 
    121       IF( ln_dynadv_vec .OR. ln_linssh ) THEN      ! applied on velocity 
    122          DO jk = 1, jpkm1 
    123             ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 
    124             va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 
    125          END DO 
    126       ELSE                                         ! applied on thickness weighted velocity 
    127          DO jk = 1, jpkm1 
    128             ua(:,:,jk) = (          ub(:,:,jk) * e3u_b(:,:,jk)    & 
    129                &           + p2dt * ua(:,:,jk) * e3u_n(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
    130             va(:,:,jk) = (          vb(:,:,jk) * e3v_b(:,:,jk)    & 
    131                &           + p2dt * va(:,:,jk) * e3v_n(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
    132          END DO 
    133       ENDIF 
    134  
    135       IF ( ln_bfrimp .AND.lk_dynspg_ts ) THEN 
    136          ! remove barotropic velocities: 
    137          DO jk = 1, jpkm1 
    138             ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 
    139             va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 
    140          END DO 
    141          ! Add bottom/top stress due to barotropic component only: 
    142          DO jj = 2, jpjm1         
     133      ! 
     134      ! With split-explicit free surface, barotropic stress is treated explicitly 
     135      ! Update velocities at the bottom. 
     136      ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does  
     137      !            not lead to the effective stress seen over the whole barotropic loop.  
     138      ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 
     139      IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 
     140         DO jk = 1, jpkm1        ! remove barotropic velocities 
     141            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 
     142            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 
     143         END DO 
     144         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only 
    143145            DO ji = fs_2, fs_jpim1   ! vector opt. 
    144146               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    145147               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    146                ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl   * e3u_a(ji,jj,ikbu) 
    147                ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl   * e3v_a(ji,jj,ikbv) 
     148               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 
     149               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 
    148150               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 
    149151               va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va 
    150152            END DO 
    151153         END DO 
    152          IF ( ln_isfcav ) THEN 
     154         IF( ln_isfcav ) THEN    ! Ocean cavities (ISF) 
    153155            DO jj = 2, jpjm1         
    154156               DO ji = fs_2, fs_jpim1   ! vector opt. 
    155157                  ikbu = miku(ji,jj)         ! top ocean level at u- and v-points  
    156158                  ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
    157                   ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl   * e3u_a(ji,jj,ikbu) 
    158                   ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl   * e3v_a(ji,jj,ikbv) 
     159                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 
     160                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 
    159161                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 
    160162                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va 
     
    163165         END IF 
    164166      ENDIF 
    165 #endif 
    166  
    167       ! 2. Vertical diffusion on u 
    168       ! --------------------------- 
     167      ! 
     168      !              !==  Vertical diffusion on u  ==! 
     169      ! 
    169170      ! Matrix and second member construction 
    170171      ! bottom boundary condition: both zwi and zws must be masked as avmu can take 
     
    174175         DO jj = 2, jpjm1  
    175176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl   * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
    177                zcoef = - p2dt / ze3ua       
    178                zzwi  = zcoef * avmu(ji,jj,jk  ) / e3uw_n(ji,jj,jk  ) 
    179                zzws  = zcoef * avmu(ji,jj,jk+1) / e3uw_n(ji,jj,jk+1)  
    180                zwi(ji,jj,jk) = zzwi  * wumask(ji,jj,jk  ) 
    181                zws(ji,jj,jk) = zzws  * wumask(ji,jj,jk+1) 
     177               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
     178               zzwi = - p2dt * avmu(ji,jj,jk  ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) 
     179               zzws = - p2dt * avmu(ji,jj,jk+1) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) 
     180               zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk  ) 
     181               zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1) 
    182182               zwd(ji,jj,jk) = 1._wp - zzwi - zzws 
    183183            END DO 
     
    214214      END DO 
    215215      ! 
    216       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
    217          DO ji = fs_2, fs_jpim1   ! vector opt. 
    218 #if defined key_dynspg_ts 
    219             ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl   * e3u_a(ji,jj,1)  
     216      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
     217         DO ji = fs_2, fs_jpim1   ! vector opt. 
     218            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)  
    220219            ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    221220               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)  
    222 #else 
    223             ua(ji,jj,1) = ub(ji,jj,1)  & 
    224                &        + p2dt *( ua(ji,jj,1) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    225                &                                        / ( e3u_n(ji,jj,1) * rau0 ) * umask(ji,jj,1) )  
    226 #endif 
    227221         END DO 
    228222      END DO 
     
    230224         DO jj = 2, jpjm1 
    231225            DO ji = fs_2, fs_jpim1 
    232 #if defined key_dynspg_ts 
    233                zrhs = ua(ji,jj,jk)   ! zrhs=right hand side 
    234 #else 
    235                zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) 
    236 #endif 
    237                ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 
    238             END DO 
    239          END DO 
    240       END DO 
    241       ! 
    242       DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  == 
     226               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 
     227            END DO 
     228         END DO 
     229      END DO 
     230      ! 
     231      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
    243232         DO ji = fs_2, fs_jpim1   ! vector opt. 
    244233            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
     
    252241         END DO 
    253242      END DO 
    254  
    255 #if ! defined key_dynspg_ts 
    256       ! Normalization to obtain the general momentum trend ua 
    257       DO jk = 1, jpkm1 
    258          DO jj = 2, jpjm1    
    259             DO ji = fs_2, fs_jpim1   ! vector opt. 
    260                ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt 
    261             END DO 
    262          END DO 
    263       END DO 
    264 #endif 
    265  
    266       ! 3. Vertical diffusion on v 
    267       ! --------------------------- 
     243      ! 
     244      !              !==  Vertical diffusion on v  ==! 
     245      ! 
    268246      ! Matrix and second member construction 
    269247      ! bottom boundary condition: both zwi and zws must be masked as avmv can take 
     
    273251         DO jj = 2, jpjm1    
    274252            DO ji = fs_2, fs_jpim1   ! vector opt. 
    275                ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk)  + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
    276                zcoef = - p2dt / ze3va 
    277                zzwi          = zcoef * avmv (ji,jj,jk  ) / e3vw_n(ji,jj,jk  ) 
    278                zwi(ji,jj,jk) =  zzwi * wvmask(ji,jj,jk) 
    279                zzws          = zcoef * avmv (ji,jj,jk+1) / e3vw_n(ji,jj,jk+1) 
    280                zws(ji,jj,jk) =  zzws * wvmask(ji,jj,jk+1) 
     253               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
     254               zzwi = - p2dt * avmv (ji,jj,jk  ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) 
     255               zzws = - p2dt * avmv (ji,jj,jk+1) / ( ze3va * e3vw_n(ji,jj,jk+1) ) 
     256               zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  ) 
     257               zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 
    281258               zwd(ji,jj,jk) = 1._wp - zzwi - zzws 
    282259            END DO 
     
    313290      END DO 
    314291      ! 
    315       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
    316          DO ji = fs_2, fs_jpim1   ! vector opt. 
    317 #if defined key_dynspg_ts             
    318             ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl   * e3v_a(ji,jj,1)  
     292      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
     293         DO ji = fs_2, fs_jpim1   ! vector opt.           
     294            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)  
    319295            va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    320296               &                                      / ( ze3va * rau0 )  
    321 #else 
    322             va(ji,jj,1) = vb(ji,jj,1)   & 
    323                &        + p2dt *( va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    324                &                                       / ( e3v_n(ji,jj,1) * rau0 )         ) 
    325 #endif 
    326297         END DO 
    327298      END DO 
     
    329300         DO jj = 2, jpjm1 
    330301            DO ji = fs_2, fs_jpim1   ! vector opt. 
    331 #if defined key_dynspg_ts 
    332                zrhs = va(ji,jj,jk)   ! zrhs=right hand side 
    333 #else 
    334                zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk) 
    335 #endif 
    336                va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 
    337             END DO 
    338          END DO 
    339       END DO 
    340       ! 
    341       DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  == 
     302               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 
     303            END DO 
     304         END DO 
     305      END DO 
     306      ! 
     307      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==! 
    342308         DO ji = fs_2, fs_jpim1   ! vector opt. 
    343309            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
     
    351317         END DO 
    352318      END DO 
    353  
    354       ! Normalization to obtain the general momentum trend va 
    355 #if ! defined key_dynspg_ts 
    356       DO jk = 1, jpkm1 
    357          DO jj = 2, jpjm1    
    358             DO ji = fs_2, fs_jpim1   ! vector opt. 
    359                va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt 
    360             END DO 
    361          END DO 
    362       END DO 
    363 #endif 
    364  
     319       
    365320      ! J. Chanut: Lines below are useless ? 
    366321      !! restore bottom layer avmu(v)  
     322      !!gm  I almost sure it is !!!! 
    367323      IF( ln_bfrimp ) THEN 
    368324        DO jj = 2, jpjm1 
     
    370326              ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    371327              ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    372               avmu(ji,jj,ikbu+1) = 0.e0 
    373               avmv(ji,jj,ikbv+1) = 0.e0 
     328              avmu(ji,jj,ikbu+1) = 0._wp 
     329              avmv(ji,jj,ikbv+1) = 0._wp 
    374330           END DO 
    375331        END DO 
     
    379335                 ikbu = miku(ji,jj)         ! ocean top level at u- and v-points  
    380336                 ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
    381                  IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0 
    382                  IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0 
     337                 IF( ikbu > 1 )   avmu(ji,jj,ikbu) = 0._wp 
     338                 IF( ikbv > 1 )   avmv(ji,jj,ikbv) = 0._wp 
    383339              END DO 
    384340           END DO 
    385         END IF 
    386       ENDIF 
    387       ! 
    388       CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)  
    389       ! 
    390       IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp') 
     341        ENDIF 
     342      ENDIF 
     343      ! 
     344      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwd, zws)  
     345      ! 
     346      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf_imp') 
    391347      ! 
    392348   END SUBROUTINE dyn_zdf_imp 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5866 r6004  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   ssh_nxt        : after ssh 
    15    !!   ssh_swp        : filter ans swap the ssh arrays 
    16    !!   wzv            : compute now vertical velocity 
    17    !!---------------------------------------------------------------------- 
    18    USE oce             ! ocean dynamics and tracers variables 
    19    USE dom_oce         ! ocean space and time domain variables  
    20    USE sbc_oce         ! surface boundary condition: ocean 
    21    USE domvvl          ! Variable volume 
    22    USE divhor          ! horizontal divergence 
    23    USE phycst          ! physical constants 
    24    USE bdy_oce 
    25    USE bdy_par          
    26    USE bdydyn2d        ! bdy_ssh routine 
     14   !!   ssh_nxt       : after ssh 
     15   !!   ssh_swp       : filter ans swap the ssh arrays 
     16   !!   wzv           : compute now vertical velocity 
     17   !!---------------------------------------------------------------------- 
     18   USE oce            ! ocean dynamics and tracers variables 
     19   USE dom_oce        ! ocean space and time domain variables  
     20   USE sbc_oce        ! surface boundary condition: ocean 
     21   USE domvvl         ! Variable volume 
     22   USE divhor         ! horizontal divergence 
     23   USE phycst         ! physical constants 
     24   USE bdy_oce        !  
     25   USE bdy_par        ! 
     26   USE bdydyn2d       ! bdy_ssh routine 
    2727#if defined key_agrif 
    2828   USE agrif_opa_interp 
    2929#endif 
    3030#if defined key_asminc    
    31    USE asminc          ! Assimilation increment 
    32 #endif 
    33    USE in_out_manager  ! I/O manager 
    34    USE restart         ! only for lrst_oce 
    35    USE prtctl          ! Print control 
    36    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    37    USE lib_mpp         ! MPP library 
    38    USE wrk_nemo        ! Memory Allocation 
    39    USE timing          ! Timing 
     31   USE   asminc       ! Assimilation increment 
     32#endif 
     33   ! 
     34   USE in_out_manager ! I/O manager 
     35   USE restart        ! only for lrst_oce 
     36   USE prtctl         ! Print control 
     37   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     38   USE lib_mpp        ! MPP library 
     39   USE wrk_nemo       ! Memory Allocation 
     40   USE timing         ! Timing 
    4041 
    4142   IMPLICIT NONE 
     
    105106      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
    106107 
    107 #if ! defined key_dynspg_ts 
    108       ! These lines are not necessary with time splitting since 
    109       ! boundary condition on sea level is set during ts loop 
     108      IF ( .NOT.ln_dynspg_ts ) THEN 
     109         ! These lines are not necessary with time splitting since 
     110         ! boundary condition on sea level is set during ts loop 
    110111# if defined key_agrif 
    111       CALL agrif_ssh( kt ) 
     112         CALL agrif_ssh( kt ) 
    112113# endif 
    113114# if defined key_bdy 
    114       IF( lk_bdy ) THEN 
    115          CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary 
    116          CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries 
    117       ENDIF 
     115         IF( lk_bdy ) THEN 
     116            CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary 
     117            CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries 
     118         ENDIF 
    118119# endif 
    119 #endif 
     120      ENDIF 
    120121 
    121122#if defined key_asminc 
     
    193194         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    194195            ! computation of w 
    195             wn(:,:,jk) = wn(:,:,jk+1) - (   e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)                    & 
    196                &                          + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
     196            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    & 
     197               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    ) * tmask(:,:,jk) 
    197198         END DO 
    198199         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
     
    201202         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    202203            ! computation of w 
    203             wn(:,:,jk) = wn(:,:,jk+1) - (   e3t_n(:,:,jk) * hdivn(:,:,jk)                                   & 
    204                &                          + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
     204            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 & 
     205               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 
    205206         END DO 
    206207      ENDIF 
     
    239240      !!---------------------------------------------------------------------- 
    240241      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     242      ! 
     243      REAL(wp) ::   zcoef   ! local scalar 
    241244      !!---------------------------------------------------------------------- 
    242245      ! 
     
    248251         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    249252      ENDIF 
    250  
    251 # if defined key_dynspg_ts 
    252       IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ln_bt_fw ) THEN    !** Euler time-stepping: no filter 
    253 # else 
    254       IF ( neuler == 0 .AND. kt == nit000 ) THEN   !** Euler time-stepping at first time-step : no filter 
    255 #endif 
    256          sshb(:,:) = sshn(:,:)                           ! before <-- now 
    257          sshn(:,:) = ssha(:,:)                           ! now    <-- after  (before already = now) 
     253      !              !==  Euler time-stepping: no filter, just swap  ==! 
     254      IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    & 
     255         & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN  
     256         sshb(:,:) = sshn(:,:)                              ! before <-- now 
     257         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now) 
    258258         ! 
    259       ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
    260          sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered 
    261          IF( .NOT.ln_linssh )   sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:)    - emp(:,:)    & 
    262                                 &                                 - rnf_b(:,:)    + rnf(:,:)    & 
    263                                 &                                 + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 
    264          sshn(:,:) = ssha(:,:)                           ! now <-- after 
     259      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==! 
     260         !                                                  ! before <-- now filtered 
     261         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 
     262         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed 
     263            zcoef = atfp * rdt * r1_rau0 
     264            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   & 
     265               &                             -    rnf_b(:,:) + rnf   (:,:)   & 
     266               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:) 
     267         ENDIF 
     268         sshn(:,:) = ssha(:,:)                              ! now <-- after 
    265269      ENDIF 
    266270      ! 
    267271      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 ) 
    268272      ! 
    269       IF( nn_timing == 1 )  CALL timing_stop('ssh_swp') 
     273      IF( nn_timing == 1 )   CALL timing_stop('ssh_swp') 
    270274      ! 
    271275   END SUBROUTINE ssh_swp 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r5215 r6004  
    4343   PUBLIC   icb_alloc   ! routine called by icb_init in icbini.F90 module 
    4444 
    45 INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes    
     45   INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes    
    4646   INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming 
    4747 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5866 r6004  
    236236         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density 
    237237      ELSE 
    238          CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )    
     238         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )    
    239239      ENDIF 
    240240      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5883 r6004  
    1414   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    1515   !!---------------------------------------------------------------------- 
    16    !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
    17    !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    18    !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
    19    !!---------------------------------------------------------------------- 
    20    USE lib_mpp          ! distributed memory computing library 
     16   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
     17   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
     18   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
     19   !!---------------------------------------------------------------------- 
     20   USE lib_mpp        ! distributed memory computing library 
    2121 
    2222   INTERFACE lbc_lnk_multi 
     
    9090    
    9191   !!---------------------------------------------------------------------- 
    92    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     92   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    9393   !! $Id$ 
    9494   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r4686 r6004  
    2424      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d 
    2525   END INTERFACE 
    26  
    27    PUBLIC   lbc_nfd   ! north fold conditions 
     26   ! 
    2827   INTERFACE mpp_lbc_nfd 
    2928      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d 
    3029   END INTERFACE 
    3130 
    32    PUBLIC   mpp_lbc_nfd   ! north fold conditions in parallel case 
    33  
    34    INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3 
    35    INTEGER, PUBLIC                                  ::   nsndto, nfsloop, nfeloop 
    36    INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate 
    37  
    38  
     31   PUBLIC   lbc_nfd       ! north fold conditions 
     32   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case) 
     33 
     34   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !: 
     35   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !: 
     36   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate 
    3937 
    4038   !!---------------------------------------------------------------------- 
     
    391389      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change 
    392390      !                                                        !   = -1. , the sign is changed if north fold boundary 
    393       !                                                        !   =  1. , the sign is kept  if north fold boundary 
    394       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl      ! 3D array on which the boundary condition is applied 
    395       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt3dr      ! 3D array on which the boundary condition is applied 
     391      !                                                        !   =  1. , the sign is kept    if north fold boundary 
     392      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied 
     393      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied 
    396394      ! 
    397395      INTEGER  ::   ji, jk 
    398396      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
    399397      !!---------------------------------------------------------------------- 
    400  
     398      ! 
    401399      SELECT CASE ( jpni ) 
    402400      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
     
    657655      !                                                      !   = -1. , the sign is changed if north fold boundary 
    658656      !                                                      !   =  1. , the sign is kept  if north fold boundary 
    659       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl      ! 2D array on which the boundary condition is applied 
    660       REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt2dr      ! 2D array on which the boundary condition is applied 
     657      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied 
     658      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied 
    661659      ! 
    662660      INTEGER  ::   ji 
     
    970968   END SUBROUTINE mpp_lbc_nfd_2d 
    971969 
     970   !!====================================================================== 
    972971END MODULE lbcnfd 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r5883 r6004  
    2727 
    2828   !!---------------------------------------------------------------------- 
    29    !!   ctl_stop   : update momentum and tracer Kz from a tke scheme 
    30    !!   ctl_warn   : initialization, namelist read, and parameters control 
    31    !!   ctl_opn    : Open file and check if required file is available. 
    32    !!   ctl_nam    : Prints informations when an error occurs while reading a namelist 
    33    !!   get_unit   : give the index of an unused logical unit 
     29   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme 
     30   !!   ctl_warn      : initialization, namelist read, and parameters control 
     31   !!   ctl_opn       : Open file and check if required file is available. 
     32   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist 
     33   !!   get_unit      : give the index of an unused logical unit 
    3434   !!---------------------------------------------------------------------- 
    3535#if   defined key_mpp_mpi 
     
    4343   !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
    4444   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 
    45    !!   mpprecv         : 
     45   !!   mpprecv       : 
    4646   !!   mppsend       :   SUBROUTINE mpp_ini_znl 
    4747   !!   mppscatter    : 
     
    9494   END INTERFACE 
    9595   INTERFACE mpp_sum 
    96       MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 
     96      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   & 
    9797                       mppsum_realdd, mppsum_a_realdd 
    9898   END INTERFACE 
     
    175175      !! ** Purpose :   Find processor unit 
    176176      !!---------------------------------------------------------------------- 
    177       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
    178       CHARACTER(len=*)             , INTENT(in   ) ::   ldname 
    179       INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist 
    180       INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist 
    181       INTEGER                      , INTENT(inout) ::   kumond         ! logical unit for namelist output 
    182       INTEGER                      , INTENT(inout) ::   kstop          ! stop indicator 
    183       INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
     177      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        ! 
     178      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       ! 
     179      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist 
     180      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist 
     181      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output 
     182      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
     183      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    ! 
    184184      ! 
    185185      INTEGER ::   mynode, ierr, code, ji, ii, ios 
     
    190190      ! 
    191191      ii = 1 
    192       WRITE(ldtxt(ii),*)                                                                          ;   ii = ii + 1 
    193       WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                            ;   ii = ii + 1 
    194       WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1 
     192      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1 
     193      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1 
     194      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1 
    195195      ! 
    196196 
     
    204204 
    205205      !                              ! control print 
    206       WRITE(ldtxt(ii),*) '   Namelist nammpp'                                                     ;   ii = ii + 1 
    207       WRITE(ldtxt(ii),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send   ;   ii = ii + 1 
    208       WRITE(ldtxt(ii),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1 
     206      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1 
     207      WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1 
     208      WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1 
    209209 
    210210#if defined key_agrif 
     
    223223 
    224224      IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
    225          WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically'; ii = ii + 1 
     225         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;  ii = ii + 1 
    226226      ELSE 
    227          WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni; ii = ii + 1 
    228          WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj; ii = ii + 1 
    229          WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij; ii = ii +1 
     227         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;  ii = ii + 1 
     228         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;  ii = ii + 1 
     229         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1 
    230230      END IF 
    231231 
     
    246246         SELECT CASE ( cn_mpi_send ) 
    247247         CASE ( 'S' )                ! Standard mpi send (blocking) 
    248             WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1 
     248            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1 
    249249         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    250             WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1 
     250            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1 
    251251            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
    252252         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    253             WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1 
     253            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1 
    254254            l_isend = .TRUE. 
    255255         CASE DEFAULT 
    256             WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1 
    257             WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1 
     256            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1 
     257            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    258258            kstop = kstop + 1 
    259259         END SELECT 
    260260      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    261          WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '                  ;   ii = ii + 1 
    262          WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                        ;   ii = ii + 1 
     261         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1 
     262         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1 
    263263         kstop = kstop + 1 
    264264      ELSE 
    265265         SELECT CASE ( cn_mpi_send ) 
    266266         CASE ( 'S' )                ! Standard mpi send (blocking) 
    267             WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1 
     267            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1 
    268268            CALL mpi_init( ierr ) 
    269269         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    270             WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1 
     270            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1 
    271271            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
    272272         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    273             WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1 
     273            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1 
    274274            l_isend = .TRUE. 
    275275            CALL mpi_init( ierr ) 
    276276         CASE DEFAULT 
    277             WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1 
    278             WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1 
     277            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1 
     278            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1 
    279279            kstop = kstop + 1 
    280280         END SELECT 
     
    319319   END FUNCTION mynode 
    320320 
     321 
    321322   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    322323      !!---------------------------------------------------------------------- 
     
    347348      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    348349      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    349       !! 
     350      ! 
    350351      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    351352      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    352353      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    353354      REAL(wp) ::   zland 
    354       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    355       ! 
     355      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend 
    356356      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
    357357      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    358  
    359358      !!---------------------------------------------------------------------- 
    360359       
     
    364363      ! 
    365364      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    366       ELSE                         ;   zland = 0.e0      ! zero by default 
     365      ELSE                         ;   zland = 0._wp     ! zero by default 
    367366      ENDIF 
    368367 
     
    455454      END SELECT 
    456455 
    457  
    458456      ! 3. North and south directions 
    459457      ! ----------------------------- 
     
    508506      END SELECT 
    509507 
    510  
    511508      ! 4. north fold treatment 
    512509      ! ----------------------- 
     
    524521      ! 
    525522   END SUBROUTINE mpp_lnk_3d 
     523 
    526524 
    527525   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) 
     
    542540      !!                    noso   : number for local neighboring processors 
    543541      !!                    nono   : number for local neighboring processors 
    544       !! 
    545       !!---------------------------------------------------------------------- 
    546  
    547       INTEGER :: num_fields 
    548       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     542      !!---------------------------------------------------------------------- 
    549543      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
    550544      !                                                               ! = T , U , V , F , W and I points 
     
    558552      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    559553      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    560  
     554      INTEGER :: num_fields 
     555      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    561556      REAL(wp) ::   zland 
    562       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    563       ! 
     557      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend 
    564558      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    565559      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    566560 
    567561      !!---------------------------------------------------------------------- 
    568  
     562      ! 
    569563      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  & 
    570564         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   ) 
    571  
    572565      ! 
    573566      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    574       ELSE                         ;   zland = 0.e0      ! zero by default 
     567      ELSE                         ;   zland = 0._wp     ! zero by default 
    575568      ENDIF 
    576569 
     
    744737         ! 
    745738      END DO 
    746        
     739      ! 
    747740      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    748741      ! 
     
    750743 
    751744    
    752    SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields) 
     745   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields ) 
    753746      !!--------------------------------------------------------------------- 
    754       REAL(wp), DIMENSION(jpi,jpj), TARGET   ,  INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied 
    755       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points 
    756       REAL(wp)                    , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary 
     747      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied 
     748      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points 
     749      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary 
    757750      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
    758751      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
    759752      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
    760       INTEGER                      , INTENT (inout):: num_fields  
     753      INTEGER                            , INTENT (inout) :: num_fields  
    761754      !!--------------------------------------------------------------------- 
    762       num_fields=num_fields+1 
    763       pt2d_array(num_fields)%pt2d=>pt2d 
    764       type_array(num_fields)=cd_type 
    765       psgn_array(num_fields)=psgn 
     755      num_fields = num_fields + 1 
     756      pt2d_array(num_fields)%pt2d => pt2d 
     757      type_array(num_fields)      =  cd_type 
     758      psgn_array(num_fields)      =  psgn 
    766759   END SUBROUTINE load_array 
    767760    
     
    792785      INTEGER :: num_fields 
    793786      !!--------------------------------------------------------------------- 
    794  
     787      ! 
    795788      num_fields = 0 
    796  
    797       !! Load the first array 
    798       CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields) 
    799  
    800       !! Look if more arrays are added 
    801       IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 
    802       IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 
    803       IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 
    804       IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 
    805       IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 
    806       IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 
    807       IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 
    808       IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 
    809        
    810       CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval) 
     789      ! 
     790      ! Load the first array 
     791      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields ) 
     792      ! 
     793      ! Look if more arrays are added 
     794      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 
     795      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 
     796      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 
     797      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 
     798      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 
     799      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 
     800      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 
     801      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 
     802      ! 
     803      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval ) 
     804      ! 
    811805   END SUBROUTINE mpp_lnk_2d_9 
    812806 
     
    843837      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    844838      REAL(wp) ::   zland 
    845       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    846       ! 
     839      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend 
    847840      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    848841      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    849  
    850       !!---------------------------------------------------------------------- 
    851  
     842      !!---------------------------------------------------------------------- 
     843      ! 
    852844      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
    853845         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    854  
    855846      ! 
    856847      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    857       ELSE                         ;   zland = 0.e0      ! zero by default 
     848      ELSE                         ;   zland = 0._wp     ! zero by default 
    858849      ENDIF 
    859850 
     
    10461037      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    10471038      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    1048       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    1049       ! 
     1039      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   ml_stat   ! for key_mpi_isend 
    10501040      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north 
    10511041      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east 
    1052  
    1053       !!---------------------------------------------------------------------- 
     1042      !!---------------------------------------------------------------------- 
     1043      ! 
    10541044      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    & 
    10551045         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 
    1056  
    1057  
     1046      ! 
    10581047      ! 1. standard boundary treatment 
    10591048      ! ------------------------------ 
     
    13991388         END DO 
    14001389      END SELECT 
    1401  
     1390      ! 
    14021391   END SUBROUTINE mpp_lnk_2d_e 
    14031392 
     
    14491438      !!---------------------------------------------------------------------- 
    14501439      ! 
    1451  
    14521440      ! If a specific process number has been passed to the receive call, 
    14531441      ! use that one. Default is to use mpi_any_source 
    1454       use_source=mpi_any_source 
    1455       if(present(ksource)) then 
    1456          use_source=ksource 
    1457       end if 
    1458  
     1442      use_source = mpi_any_source 
     1443      IF( PRESENT(ksource) )   use_source = ksource 
     1444      ! 
    14591445      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag ) 
    14601446      ! 
     
    14701456      !! 
    14711457      !!---------------------------------------------------------------------- 
    1472       REAL(wp), DIMENSION(jpi,jpj),      INTENT(in   ) ::   ptab   ! subdomain input array 
    1473       INTEGER ,                          INTENT(in   ) ::   kp     ! record length 
     1458      REAL(wp), DIMENSION(jpi,jpj)      , INTENT(in   ) ::   ptab   ! subdomain input array 
     1459      INTEGER                           , INTENT(in   ) ::   kp     ! record length 
    14741460      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array 
    14751461      !! 
     
    14921478      !! 
    14931479      !!---------------------------------------------------------------------- 
    1494       REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array 
    1495       INTEGER                             ::   kp        ! Tag (not used with MPI 
    1496       REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input 
     1480      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::   pio    ! output array 
     1481      INTEGER                             ::   kp     ! Tag (not used with MPI 
     1482      REAL(wp), DIMENSION(jpi,jpj)        ::   ptab   ! subdomain array input 
    14971483      !! 
    14981484      INTEGER :: itaille, ierror   ! temporary integer 
    14991485      !!--------------------------------------------------------------------- 
    15001486      ! 
    1501       itaille=jpi*jpj 
     1487      itaille = jpi * jpj 
    15021488      ! 
    15031489      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   & 
     
    15171503      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array 
    15181504      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
    1519       !! 
     1505      ! 
    15201506      INTEGER :: ierror, localcomm   ! temporary integer 
    15211507      INTEGER, DIMENSION(kdim) ::   iwork 
     
    15391525      !! 
    15401526      !!---------------------------------------------------------------------- 
    1541       INTEGER, INTENT(inout)           ::   ktab      ! ??? 
    1542       INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ??? 
    1543       !! 
     1527      INTEGER, INTENT(inout)           ::   ktab   ! ??? 
     1528      INTEGER, INTENT(in   ), OPTIONAL ::   kcom   ! ??? 
     1529      ! 
    15441530      INTEGER ::   ierror, iwork, localcomm   ! temporary integer 
    15451531      !!---------------------------------------------------------------------- 
     
    15481534      IF( PRESENT(kcom) )   localcomm = kcom 
    15491535      ! 
    1550       CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror) 
     1536      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror ) 
    15511537      ! 
    15521538      ktab = iwork 
     
    15621548      !! 
    15631549      !!---------------------------------------------------------------------- 
    1564       INTEGER , INTENT( in  )                  ::   kdim        ! size of array 
    1565       INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array 
    1566       INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array 
     1550      INTEGER , INTENT( in  )                  ::   kdim   ! size of array 
     1551      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array 
     1552      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom   ! input array 
    15671553      !! 
    15681554      INTEGER ::   ierror, localcomm   ! temporary integer 
     
    15961582      IF( PRESENT(kcom) )   localcomm = kcom 
    15971583      ! 
    1598      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 
     1584      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 
    15991585      ! 
    16001586      ktab = iwork 
     
    16101596      !! 
    16111597      !!---------------------------------------------------------------------- 
    1612       INTEGER, INTENT(in   )                   ::   kdim      ! ??? 
    1613       INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ??? 
    1614       !! 
     1598      INTEGER, INTENT(in   )                   ::   kdim   ! ??? 
     1599      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ??? 
     1600      ! 
    16151601      INTEGER :: ierror 
    16161602      INTEGER, DIMENSION (kdim) ::  iwork 
     
    16531639      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
    16541640      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom 
    1655       !! 
     1641      ! 
    16561642      INTEGER :: ierror, localcomm 
    16571643      REAL(wp), DIMENSION(kdim) ::  zwork 
     
    17851771   END SUBROUTINE mppsum_real 
    17861772 
     1773 
    17871774   SUBROUTINE mppsum_realdd( ytab, kcom ) 
    17881775      !!---------------------------------------------------------------------- 
     
    17931780      !! 
    17941781      !!----------------------------------------------------------------------- 
    1795       COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar 
    1796       INTEGER , INTENT( in  ), OPTIONAL :: kcom 
    1797  
    1798       !! * Local variables   (MPI version) 
    1799       INTEGER  ::    ierror 
    1800       INTEGER  ::   localcomm 
    1801       COMPLEX(wp) :: zwork 
    1802  
     1782      COMPLEX(wp), INTENT(inout)           ::  ytab    ! input scalar 
     1783      INTEGER    , INTENT(in   ), OPTIONAL ::  kcom 
     1784      ! 
     1785      INTEGER     ::   ierror 
     1786      INTEGER     ::   localcomm 
     1787      COMPLEX(wp) ::   zwork 
     1788      !!----------------------------------------------------------------------- 
     1789      ! 
    18031790      localcomm = mpi_comm_opa 
    1804       IF( PRESENT(kcom) ) localcomm = kcom 
    1805  
     1791      IF( PRESENT(kcom) )   localcomm = kcom 
     1792      ! 
    18061793      ! reduce local sums into global sum 
    1807       CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, & 
    1808                        MPI_SUMDD,localcomm,ierror) 
     1794      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 
    18091795      ytab = zwork 
    1810  
     1796      ! 
    18111797   END SUBROUTINE mppsum_realdd 
    18121798 
     
    18201806      !! 
    18211807      !!----------------------------------------------------------------------- 
    1822       INTEGER , INTENT( in )                        ::   kdim      ! size of ytab 
    1823       COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array 
    1824       INTEGER , INTENT( in  ), OPTIONAL :: kcom 
    1825  
    1826       !! * Local variables   (MPI version) 
    1827       INTEGER                      :: ierror    ! temporary integer 
    1828       INTEGER                      ::   localcomm 
     1808      INTEGER                     , INTENT(in   ) ::   kdim   ! size of ytab 
     1809      COMPLEX(wp), DIMENSION(kdim), INTENT(inout) ::   ytab   ! input array 
     1810      INTEGER    , OPTIONAL       , INTENT(in   ) ::   kcom 
     1811      ! 
     1812      INTEGER:: ierror, localcomm    ! local integer 
    18291813      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace 
    1830  
     1814      !!----------------------------------------------------------------------- 
     1815      ! 
    18311816      localcomm = mpi_comm_opa 
    1832       IF( PRESENT(kcom) ) localcomm = kcom 
    1833  
    1834       CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, & 
    1835                        MPI_SUMDD,localcomm,ierror) 
     1817      IF( PRESENT(kcom) )   localcomm = kcom 
     1818      ! 
     1819      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 
    18361820      ytab(:) = zwork(:) 
    1837  
     1821      ! 
    18381822   END SUBROUTINE mppsum_a_realdd 
     1823 
    18391824 
    18401825   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
     
    18521837      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    18531838      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame 
    1854       !! 
     1839      ! 
     1840      INTEGER :: ierror 
    18551841      INTEGER , DIMENSION(2)   ::   ilocs 
    1856       INTEGER :: ierror 
    18571842      REAL(wp) ::   zmin   ! local minimum 
    18581843      REAL(wp), DIMENSION(2,1) ::   zain, zaout 
     
    27042689         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    27052690 
    2706       zland = 0.-WP 
     2691      zland = 0._wp 
    27072692 
    27082693      ! 1. standard boundary treatment 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5866 r6004  
    185185               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
    186186               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
    187                zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              & 
    188                   &                   + zfi  * uslpml(ji,jj)                                                     & 
     187               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                                & 
     188                  &                   + zfi  * uslpml(ji,jj)                                                       & 
    189189                  &                          * 0.5_wp * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk)-e3u_n(ji,jj,1) )   & 
    190190                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 
    191                zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              & 
    192                   &                   + zfj  * vslpml(ji,jj)                                                     & 
     191               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                                & 
     192                  &                   + zfj  * vslpml(ji,jj)                                                       & 
    193193                  &                          * 0.5_wp * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk)-e3v_n(ji,jj,1) )   & 
    194194                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5883 r6004  
    1616   USE dom_oce        ! ocean space and time domain 
    1717   USE phycst         ! physical constant 
     18   USE sbc_oce        ! surface boundary conditions : fields 
     19   USE geo2ocean      ! for vector rotation on to model grid 
     20   ! 
    1821   USE in_out_manager ! I/O manager 
    1922   USE iom            ! I/O manager library 
    20    USE geo2ocean      ! for vector rotation on to model grid 
     23   USE ioipsl  , ONLY : ymds2ju, ju2ymds   ! for calendar 
    2124   USE lib_mpp        ! MPP library 
    2225   USE wrk_nemo       ! work arrays 
    2326   USE lbclnk         ! ocean lateral boundary conditions (C1D case) 
    24    USE ioipsl, ONLY   : ymds2ju, ju2ymds   ! for calendar 
    25    USE sbc_oce 
    2627    
    2728   IMPLICIT NONE 
     
    134135      !                                                     !   kt_offset = +1 => fields at "after"  time level 
    135136      !                                                     !   etc. 
    136       ! 
    137       INTEGER  ::   itmp         ! temporary variable 
     137      INTEGER  ::   itmp         ! local variable 
    138138      INTEGER  ::   imf          ! size of the structure sd 
    139139      INTEGER  ::   jf           ! dummy indices 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r5883 r6004  
    113113         END SELECT 
    114114      CASE DEFAULT   ;   CALL ctl_stop( 'rot_rep: Syntax Error in the definition of cdtodo' ) 
     115      ! 
    115116      END SELECT 
    116117      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r5845 r6004  
    1212   USE dom_oce         ! ocean space and time domain 
    1313   USE sbc_oce         ! surface boundary condition 
    14    USE dynspg_oce      ! surface pressure gradient variables 
    1514   USE phycst          ! physical constants 
     15   ! 
    1616   USE fldread         ! read input fields 
    1717   USE in_out_manager  ! I/O manager 
     
    110110            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
    111111         ENDIF 
    112          IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   & 
    113             CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 
    114          IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   & 
     112!jc: stop below should rather be a warning  
     113         IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   & 
    115114            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
    116115      ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5845 r6004  
    1919 
    2020   !!---------------------------------------------------------------------- 
    21    !!   sbc_blk_core    : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 
    22    !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean 
    23    !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice 
    24    !!   turb_core_2z    : Computes turbulent transfert coefficients 
    25    !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m 
    26    !!   psi_m           : universal profile stability function for momentum 
    27    !!   psi_h           : universal profile stability function for temperature and humidity 
     21   !!   sbc_blk_core  : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 
     22   !!   blk_oce_core  : computes momentum, heat and freshwater fluxes over ocean 
     23   !!   blk_ice_core  : computes momentum, heat and freshwater fluxes over ice 
     24   !!   turb_core_2z  : Computes turbulent transfert coefficients 
     25   !!   cd_neutral_10m: Estimate of the neutral drag coefficient at 10m 
     26   !!   psi_m         : universal profile stability function for momentum 
     27   !!   psi_h         : universal profile stability function for temperature and humidity 
    2828   !!---------------------------------------------------------------------- 
    29    USE oce             ! ocean dynamics and tracers 
    30    USE dom_oce         ! ocean space and time domain 
    31    USE phycst          ! physical constants 
    32    USE fldread         ! read input fields 
    33    USE sbc_oce         ! Surface boundary condition: ocean fields 
    34    USE cyclone         ! Cyclone 10m wind form trac of cyclone centres 
    35    USE sbcdcy          ! surface boundary condition: diurnal cycle 
    36    USE iom             ! I/O manager library 
    37    USE in_out_manager  ! I/O manager 
    38    USE lib_mpp         ! distribued memory computing library 
    39    USE wrk_nemo        ! work arrays 
    40    USE timing          ! Timing 
    41    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    42    USE prtctl          ! Print control 
    43    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    44    USE sbc_ice         ! Surface boundary condition: ice fields 
    45    USE lib_fortran     ! to use key_nosignedzero 
     29   USE oce            ! ocean dynamics and tracers 
     30   USE dom_oce        ! ocean space and time domain 
     31   USE phycst         ! physical constants 
     32   USE fldread        ! read input fields 
     33   USE sbc_oce        ! Surface boundary condition: ocean fields 
     34   USE cyclone        ! Cyclone 10m wind form trac of cyclone centres 
     35   USE sbcdcy         ! surface boundary condition: diurnal cycle 
     36   USE sbcwave , ONLY :   cdn_wave ! wave module 
     37   USE sbc_ice        ! Surface boundary condition: ice fields 
     38   USE lib_fortran    ! to use key_nosignedzero 
    4639#if defined key_lim3 
    47    USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b 
    48    USE limthd_dh       ! for CALL lim_thd_snwblow 
     40   USE ice     , ONLY :  u_ice, v_ice, jpl, pfrld, a_i_b 
     41   USE limthd_dh      ! for CALL lim_thd_snwblow 
    4942#elif defined key_lim2 
    50    USE ice_2, ONLY     : u_ice, v_ice 
    51    USE par_ice_2 
     43   USE ice_2   , ONLY :  u_ice, v_ice 
     44   USE par_ice_2      ! LIM-2 parameters 
    5245#endif 
     46   ! 
     47   USE iom            ! I/O manager library 
     48   USE in_out_manager ! I/O manager 
     49   USE lib_mpp        ! distribued memory computing library 
     50   USE wrk_nemo       ! work arrays 
     51   USE timing         ! Timing 
     52   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     53   USE prtctl         ! Print control 
    5354 
    5455   IMPLICIT NONE 
     
    8485   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant 
    8586 
    86    !                                  !!* Namelist namsbc_core : CORE bulk parameters 
     87   !                        !!* Namelist namsbc_core : CORE bulk parameters 
    8788   LOGICAL  ::   ln_taudif   ! logical flag to use the "mean of stress module - module of mean stress" data 
    8889   REAL(wp) ::   rn_pfac     ! multiplication factor for precipitation 
     
    148149      TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
    149150      NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac,  & 
    150          &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    151          &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           & 
    152          &                  sn_tdif, rn_zqt,  rn_zu 
     151         &                  sn_wndi, sn_wndj  , sn_humi, sn_qsr ,           & 
     152         &                  sn_qlw , sn_tair  , sn_prec, sn_snow,           & 
     153         &                  sn_tdif, rn_zqt   ,  rn_zu 
    153154      !!--------------------------------------------------------------------- 
    154155      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r5845 r6004  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   sbc_blk_mfs  : bulk formulation as ocean surface boundary condition 
     10   !!   sbc_blk_mfs   : bulk formulation as ocean surface boundary condition 
    1111   !!                   (forced mode, mfs bulk formulae) 
    12    !!   blk_oce_mfs  : ocean: computes momentum, heat and freshwater fluxes 
     12   !!   blk_oce_mfs   : ocean: computes momentum, heat and freshwater fluxes 
    1313   !!---------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and tracers 
    15    USE dom_oce         ! ocean space and time domain 
    16    USE phycst          ! physical constants 
    17    USE fldread         ! read input fields 
    18    USE sbc_oce         ! Surface boundary condition: ocean fields 
    19    USE iom             ! I/O manager library 
    20    USE in_out_manager  ! I/O manager 
    21    USE lib_mpp         ! distribued memory computing library 
    22    USE wrk_nemo        ! work arrays 
    23    USE timing          ! Timing 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25    USE prtctl          ! Print control 
    26    USE sbcwave,ONLY : cdn_wave !wave module 
     14   USE oce            ! ocean dynamics and tracers 
     15   USE dom_oce        ! ocean space and time domain 
     16   USE phycst         ! physical constants 
     17   USE fldread        ! read input fields 
     18   USE sbc_oce        ! Surface boundary condition: ocean fields 
     19   USE sbcwave  ,ONLY :   cdn_wave !wave module 
     20   ! 
     21   USE iom            ! I/O manager library 
     22   USE in_out_manager ! I/O manager 
     23   USE lib_mpp        ! distribued memory computing library 
     24   USE wrk_nemo       ! work arrays 
     25   USE timing         ! Timing 
     26   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     27   USE prtctl         ! Print control 
    2728 
    2829   IMPLICIT NONE 
     
    4849   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4950   !!---------------------------------------------------------------------- 
    50  
    5151CONTAINS 
    52  
    5352 
    5453   SUBROUTINE sbc_blk_mfs( kt ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5866 r6004  
    1818   !!   sbc_cpl_snd     : send     fields to the atmosphere 
    1919   !!---------------------------------------------------------------------- 
    20    USE dom_oce         ! ocean space and time domain 
    21    USE sbc_oce         ! Surface boundary condition: ocean fields 
    22    USE sbc_ice         ! Surface boundary condition: ice fields 
    23    USE sbcapr 
    24    USE sbcdcy          ! surface boundary condition: diurnal cycle 
    25    USE phycst          ! physical constants 
     20   USE dom_oce        ! ocean space and time domain 
     21   USE sbc_oce        ! Surface boundary condition: ocean fields 
     22   USE sbc_ice        ! Surface boundary condition: ice fields 
     23   USE sbcapr         ! Stochastic param. : ??? 
     24   USE sbcdcy         ! surface boundary condition: diurnal cycle 
     25   USE phycst         ! physical constants 
    2626#if defined key_lim3 
    27    USE ice             ! ice variables 
     27   USE ice            ! ice variables 
    2828#endif 
    2929#if defined key_lim2 
    30    USE par_ice_2       ! ice parameters 
    31    USE ice_2           ! ice variables 
     30   USE par_ice_2      ! ice parameters 
     31   USE ice_2          ! ice variables 
    3232#endif 
    33    USE cpl_oasis3      ! OASIS3 coupling 
    34    USE geo2ocean       !  
     33   USE cpl_oasis3     ! OASIS3 coupling 
     34   USE geo2ocean      !  
    3535   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    36    USE albedo          ! 
    37    USE in_out_manager  ! I/O manager 
    38    USE iom             ! NetCDF library 
    39    USE lib_mpp         ! distribued memory computing library 
    40    USE wrk_nemo        ! work arrays 
    41    USE timing          ! Timing 
    42    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    43    USE eosbn2 
    44    USE sbcrnf   , ONLY : l_rnfcpl 
     36   USE albedo         !  
     37   USE eosbn2         !  
     38   USE sbcrnf  , ONLY : l_rnfcpl 
    4539#if defined key_cpl_carbon_cycle 
    4640   USE p4zflx, ONLY : oce_co2 
     
    5044#endif 
    5145#if defined key_lim3 
    52    USE limthd_dh       ! for CALL lim_thd_snwblow 
     46   USE limthd_dh      ! for CALL lim_thd_snwblow 
    5347#endif 
     48   ! 
     49   USE in_out_manager ! I/O manager 
     50   USE iom            ! NetCDF library 
     51   USE lib_mpp        ! distribued memory computing library 
     52   USE wrk_nemo       ! work arrays 
     53   USE timing         ! Timing 
     54   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    5455 
    5556   IMPLICIT NONE 
    5657   PRIVATE 
    5758 
    58    PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    59    PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
    60    PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
    61    PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90 
    62    PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90 
    63    PUBLIC   sbc_cpl_alloc      ! routine called in sbcice_cice.F90 
    64  
    65    INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1 
    66    INTEGER, PARAMETER ::   jpr_oty1   =  2            !  
    67    INTEGER, PARAMETER ::   jpr_otz1   =  3            !  
    68    INTEGER, PARAMETER ::   jpr_otx2   =  4            ! 3 atmosphere-ocean stress components on grid 2 
    69    INTEGER, PARAMETER ::   jpr_oty2   =  5            !  
    70    INTEGER, PARAMETER ::   jpr_otz2   =  6            !  
    71    INTEGER, PARAMETER ::   jpr_itx1   =  7            ! 3 atmosphere-ice   stress components on grid 1 
    72    INTEGER, PARAMETER ::   jpr_ity1   =  8            !  
    73    INTEGER, PARAMETER ::   jpr_itz1   =  9            !  
    74    INTEGER, PARAMETER ::   jpr_itx2   = 10            ! 3 atmosphere-ice   stress components on grid 2 
    75    INTEGER, PARAMETER ::   jpr_ity2   = 11            !  
    76    INTEGER, PARAMETER ::   jpr_itz2   = 12            !  
    77    INTEGER, PARAMETER ::   jpr_qsroce = 13            ! Qsr above the ocean 
    78    INTEGER, PARAMETER ::   jpr_qsrice = 14            ! Qsr above the ice 
     59   PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90 
     60   PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90 
     61   PUBLIC   sbc_cpl_snd       ! routine called by step.F90 
     62   PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90 
     63   PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90 
     64   PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90 
     65 
     66   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1 
     67   INTEGER, PARAMETER ::   jpr_oty1   =  2   !  
     68   INTEGER, PARAMETER ::   jpr_otz1   =  3   !  
     69   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2 
     70   INTEGER, PARAMETER ::   jpr_oty2   =  5   !  
     71   INTEGER, PARAMETER ::   jpr_otz2   =  6   !  
     72   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1 
     73   INTEGER, PARAMETER ::   jpr_ity1   =  8   !  
     74   INTEGER, PARAMETER ::   jpr_itz1   =  9   !  
     75   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2 
     76   INTEGER, PARAMETER ::   jpr_ity2   = 11   !  
     77   INTEGER, PARAMETER ::   jpr_itz2   = 12   !  
     78   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean 
     79   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice 
    7980   INTEGER, PARAMETER ::   jpr_qsrmix = 15  
    80    INTEGER, PARAMETER ::   jpr_qnsoce = 16            ! Qns above the ocean 
    81    INTEGER, PARAMETER ::   jpr_qnsice = 17            ! Qns above the ice 
     81   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean 
     82   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice 
    8283   INTEGER, PARAMETER ::   jpr_qnsmix = 18 
    83    INTEGER, PARAMETER ::   jpr_rain   = 19            ! total liquid precipitation (rain) 
    84    INTEGER, PARAMETER ::   jpr_snow   = 20            ! solid precipitation over the ocean (snow) 
    85    INTEGER, PARAMETER ::   jpr_tevp   = 21            ! total evaporation 
    86    INTEGER, PARAMETER ::   jpr_ievp   = 22            ! solid evaporation (sublimation) 
    87    INTEGER, PARAMETER ::   jpr_sbpr   = 23            ! sublimation - liquid precipitation - solid precipitation 
    88    INTEGER, PARAMETER ::   jpr_semp   = 24            ! solid freshwater budget (sublimation - snow) 
    89    INTEGER, PARAMETER ::   jpr_oemp   = 25            ! ocean freshwater budget (evap - precip) 
    90    INTEGER, PARAMETER ::   jpr_w10m   = 26            ! 10m wind 
    91    INTEGER, PARAMETER ::   jpr_dqnsdt = 27            ! d(Q non solar)/d(temperature) 
    92    INTEGER, PARAMETER ::   jpr_rnf    = 28            ! runoffs 
    93    INTEGER, PARAMETER ::   jpr_cal    = 29            ! calving 
    94    INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module 
     84   INTEGER, PARAMETER ::   jpr_rain   = 19   ! total liquid precipitation (rain) 
     85   INTEGER, PARAMETER ::   jpr_snow   = 20   ! solid precipitation over the ocean (snow) 
     86   INTEGER, PARAMETER ::   jpr_tevp   = 21   ! total evaporation 
     87   INTEGER, PARAMETER ::   jpr_ievp   = 22   ! solid evaporation (sublimation) 
     88   INTEGER, PARAMETER ::   jpr_sbpr   = 23   ! sublimation - liquid precipitation - solid precipitation 
     89   INTEGER, PARAMETER ::   jpr_semp   = 24   ! solid freshwater budget (sublimation - snow) 
     90   INTEGER, PARAMETER ::   jpr_oemp   = 25   ! ocean freshwater budget (evap - precip) 
     91   INTEGER, PARAMETER ::   jpr_w10m   = 26   ! 10m wind 
     92   INTEGER, PARAMETER ::   jpr_dqnsdt = 27   ! d(Q non solar)/d(temperature) 
     93   INTEGER, PARAMETER ::   jpr_rnf    = 28   ! runoffs 
     94   INTEGER, PARAMETER ::   jpr_cal    = 29   ! calving 
     95   INTEGER, PARAMETER ::   jpr_taum   = 30   ! wind stress module 
    9596   INTEGER, PARAMETER ::   jpr_co2    = 31 
    96    INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    97    INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    98    INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux 
    99    INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature 
    100    INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity 
    101    INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1 
    102    INTEGER, PARAMETER ::   jpr_ocy1   = 38            ! 
    103    INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height 
    104    INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction           
    105    INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
    106    INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
    108  
    109    INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    110    INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    111    INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
    112    INTEGER, PARAMETER ::   jps_tmix   =  4            ! mixed temperature (ocean+ice) 
    113    INTEGER, PARAMETER ::   jps_albice =  5            ! ice   albedo 
    114    INTEGER, PARAMETER ::   jps_albmix =  6            ! mixed albedo 
    115    INTEGER, PARAMETER ::   jps_hice   =  7            ! ice  thickness 
    116    INTEGER, PARAMETER ::   jps_hsnw   =  8            ! snow thickness 
    117    INTEGER, PARAMETER ::   jps_ocx1   =  9            ! ocean current on grid 1 
    118    INTEGER, PARAMETER ::   jps_ocy1   = 10            ! 
    119    INTEGER, PARAMETER ::   jps_ocz1   = 11            ! 
    120    INTEGER, PARAMETER ::   jps_ivx1   = 12            ! ice   current on grid 1 
    121    INTEGER, PARAMETER ::   jps_ivy1   = 13            ! 
    122    INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
     97   INTEGER, PARAMETER ::   jpr_topm   = 32   ! topmeltn 
     98   INTEGER, PARAMETER ::   jpr_botm   = 33   ! botmeltn 
     99   INTEGER, PARAMETER ::   jpr_sflx   = 34   ! salt flux 
     100   INTEGER, PARAMETER ::   jpr_toce   = 35   ! ocean temperature 
     101   INTEGER, PARAMETER ::   jpr_soce   = 36   ! ocean salinity 
     102   INTEGER, PARAMETER ::   jpr_ocx1   = 37   ! ocean current on grid 1 
     103   INTEGER, PARAMETER ::   jpr_ocy1   = 38   ! 
     104   INTEGER, PARAMETER ::   jpr_ssh    = 39   ! sea surface height 
     105   INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction           
     106   INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness  
     107   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level 
     108   INTEGER, PARAMETER ::   jprcv      = 42   ! total number of fields received 
     109 
     110   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
     111   INTEGER, PARAMETER ::   jps_toce   =  2   ! ocean temperature 
     112   INTEGER, PARAMETER ::   jps_tice   =  3   ! ice   temperature 
     113   INTEGER, PARAMETER ::   jps_tmix   =  4   ! mixed temperature (ocean+ice) 
     114   INTEGER, PARAMETER ::   jps_albice =  5   ! ice   albedo 
     115   INTEGER, PARAMETER ::   jps_albmix =  6   ! mixed albedo 
     116   INTEGER, PARAMETER ::   jps_hice   =  7   ! ice  thickness 
     117   INTEGER, PARAMETER ::   jps_hsnw   =  8   ! snow thickness 
     118   INTEGER, PARAMETER ::   jps_ocx1   =  9   ! ocean current on grid 1 
     119   INTEGER, PARAMETER ::   jps_ocy1   = 10   ! 
     120   INTEGER, PARAMETER ::   jps_ocz1   = 11   ! 
     121   INTEGER, PARAMETER ::   jps_ivx1   = 12   ! ice   current on grid 1 
     122   INTEGER, PARAMETER ::   jps_ivy1   = 13   ! 
     123   INTEGER, PARAMETER ::   jps_ivz1   = 14   ! 
    123124   INTEGER, PARAMETER ::   jps_co2    = 15 
    124    INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity 
    125    INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height 
    126    INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean 
    127    INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean 
    128    INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip) 
    129    INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux 
    130    INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1 
    131    INTEGER, PARAMETER ::   jps_oty1   = 23            !  
    132    INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs 
    133    INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module 
    134    INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
    135    INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
    136    INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
    137    INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
    138  
    139    !                                                         !!** namelist namsbc_cpl ** 
    140    TYPE ::   FLD_C 
    141       CHARACTER(len = 32) ::   cldes                  ! desciption of the coupling strategy 
    142       CHARACTER(len = 32) ::   clcat                  ! multiple ice categories strategy 
    143       CHARACTER(len = 32) ::   clvref                 ! reference of vector ('spherical' or 'cartesian') 
    144       CHARACTER(len = 32) ::   clvor                  ! orientation of vector fields ('eastward-northward' or 'local grid') 
    145       CHARACTER(len = 32) ::   clvgrd                 ! grids on which is located the vector fields 
     125   INTEGER, PARAMETER ::   jps_soce   = 16   ! ocean salinity 
     126   INTEGER, PARAMETER ::   jps_ssh    = 17   ! sea surface height 
     127   INTEGER, PARAMETER ::   jps_qsroce = 18   ! Qsr above the ocean 
     128   INTEGER, PARAMETER ::   jps_qnsoce = 19   ! Qns above the ocean 
     129   INTEGER, PARAMETER ::   jps_oemp   = 20   ! ocean freshwater budget (evap - precip) 
     130   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux 
     131   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1 
     132   INTEGER, PARAMETER ::   jps_oty1   = 23   !  
     133   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs 
     134   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module 
     135   INTEGER, PARAMETER ::   jps_fice2  = 26   ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
     136   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl) 
     137   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level 
     138   INTEGER, PARAMETER ::   jpsnd      = 28   ! total number of fields sended 
     139 
     140   !                                  !!** namelist namsbc_cpl ** 
     141   TYPE ::   FLD_C                     !    
     142      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy 
     143      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy 
     144      CHARACTER(len = 32) ::   clvref     ! reference of vector ('spherical' or 'cartesian') 
     145      CHARACTER(len = 32) ::   clvor      ! orientation of vector fields ('eastward-northward' or 'local grid') 
     146      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields 
    146147   END TYPE FLD_C 
    147    ! Send to the atmosphere                           ! 
     148   !                                   ! Send to the atmosphere   
    148149   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
    149    ! Received from the atmosphere                     ! 
     150   !                                   ! Received from the atmosphere 
    150151   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    151152   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
    152    ! Other namelist parameters                        ! 
    153    INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    154    LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    155                                            !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     153   !                                   ! Other namelist parameters 
     154   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     155   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
     156                                         !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    156157   TYPE ::   DYNARR      
    157158      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
    158159   END TYPE DYNARR 
    159160 
    160    TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                      ! all fields recieved from the atmosphere 
    161  
    162    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
    163  
    164    INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
     161   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                     ! all fields recieved from the atmosphere 
     162 
     163   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     164 
     165   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo          ! OASIS info argument 
    165166 
    166167   !! Substitution 
    167168#  include "vectopt_loop_substitute.h90" 
    168169   !!---------------------------------------------------------------------- 
    169    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     170   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    170171   !! $Id$ 
    171172   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    172173   !!---------------------------------------------------------------------- 
    173  
    174174CONTAINS 
    175175   
     
    208208      !!              * initialise the OASIS coupler 
    209209      !!---------------------------------------------------------------------- 
    210       INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    211       !! 
    212       INTEGER ::   jn   ! dummy loop index 
    213       INTEGER ::   ios  ! Local integer output status for namelist read 
    214       INTEGER ::   inum  
     210      INTEGER, INTENT(in) ::   k_ice   ! ice management in the sbc (=0/1/2/3) 
     211      ! 
     212      INTEGER ::   jn          ! dummy loop index 
     213      INTEGER ::   ios, inum   ! Local integer 
    215214      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    216215      !! 
     
    221220      !!--------------------------------------------------------------------- 
    222221      ! 
    223       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_init') 
    224       ! 
    225       CALL wrk_alloc( jpi,jpj, zacs, zaos ) 
     222      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_init') 
     223      ! 
     224      CALL wrk_alloc( jpi,jpj,   zacs, zaos ) 
    226225 
    227226      ! ================================ ! 
    228227      !      Namelist informations       ! 
    229228      ! ================================ ! 
    230  
     229      ! 
    231230      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 
    232231      READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 
    233 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 
    234  
     232901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 
     233      ! 
    235234      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 
    236235      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 
    237 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
     236902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
    238237      IF(lwm) WRITE ( numond, namsbc_cpl ) 
    239  
     238      ! 
    240239      IF(lwp) THEN                        ! control print 
    241240         WRITE(numout,*) 
     
    373372         srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp. 
    374373      ENDIF 
    375         
     374      ! 
    376375      !                                                      ! ------------------------- ! 
    377376      !                                                      !    freshwater budget      !   E-P 
     
    395394      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
    396395      END SELECT 
    397  
     396      ! 
    398397      !                                                      ! ------------------------- ! 
    399398      !                                                      !     Runoffs & Calving     !    
     
    409408      ! 
    410409      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    411  
     410      ! 
    412411      !                                                      ! ------------------------- ! 
    413412      !                                                      !    non solar radiation    !   Qns 
     
    784783      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    785784 
    786       CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
    787       ! 
    788       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_init') 
     785      CALL wrk_dealloc( jpi,jpj,   zacs, zaos ) 
     786      ! 
     787      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_init') 
    789788      ! 
    790789   END SUBROUTINE sbc_cpl_init 
     
    836835      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    837836      !!---------------------------------------------------------------------- 
    838       INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
    839       INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
    840       INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     837      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
     838      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
     839      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    841840 
    842841      !! 
     
    852851      !!---------------------------------------------------------------------- 
    853852      ! 
    854       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    855       ! 
    856       CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     853      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_rcv') 
     854      ! 
     855      CALL wrk_alloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr ) 
    857856      ! 
    858857      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    11031102         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
    11041103         ! 
    1105  
    1106       ENDIF 
    1107       ! 
    1108       CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
    1109       ! 
    1110       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     1104      ENDIF 
     1105      ! 
     1106      CALL wrk_dealloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1107      ! 
     1108      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_rcv') 
    11111109      ! 
    11121110   END SUBROUTINE sbc_cpl_rcv 
     
    11491147      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    11501148      !! 
    1151       INTEGER ::   ji, jj                          ! dummy loop indices 
    1152       INTEGER ::   itx                             ! index of taux over ice 
     1149      INTEGER ::   ji, jj   ! dummy loop indices 
     1150      INTEGER ::   itx      ! index of taux over ice 
    11531151      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
    11541152      !!---------------------------------------------------------------------- 
    11551153      ! 
    1156       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_tau') 
    1157       ! 
    1158       CALL wrk_alloc( jpi,jpj, ztx, zty ) 
     1154      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_ice_tau') 
     1155      ! 
     1156      CALL wrk_alloc( jpi,jpj,   ztx, zty ) 
    11591157 
    11601158      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
     
    11641162      ! do something only if we just received the stress from atmosphere 
    11651163      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    1166  
    11671164         !                                                      ! ======================= ! 
    11681165         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     
    13171314      ENDIF 
    13181315      !    
    1319       CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
    1320       ! 
    1321       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_tau') 
     1316      CALL wrk_dealloc( jpi,jpj,   ztx, zty ) 
     1317      ! 
     1318      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_tau') 
    13221319      ! 
    13231320   END SUBROUTINE sbc_cpl_ice_tau 
     
    13641361      !!                   sprecip             solid precipitation over the ocean   
    13651362      !!---------------------------------------------------------------------- 
    1366       REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
     1363      REAL(wp), INTENT(in   ), DIMENSION(:,:)             ::   p_frld  ! lead fraction            [0 to 1] 
    13671364      ! optional arguments, used only in 'mixed oce-ice' case 
    1368       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
    1369       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
    1370       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
    1371       ! 
    1372       INTEGER ::   jl         ! dummy loop index 
     1365      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
     1366      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature  [Celsius] 
     1367      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature  [Kelvin] 
     1368      ! 
     1369      INTEGER ::   jl   ! dummy loop index 
    13731370      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
    13741371      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
     
    13771374      !!---------------------------------------------------------------------- 
    13781375      ! 
    1379       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    1380       ! 
    1381       CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
    1382       CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1376      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_ice_flx') 
     1377      ! 
     1378      CALL wrk_alloc( jpi,jpj,       zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1379      CALL wrk_alloc( jpi,jpj,jpl,   zqns_ice, zqsr_ice, zdqns_ice ) 
    13831380 
    13841381      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    15531550      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
    15541551#else 
    1555  
    1556       ! clem: this formulation is certainly wrong... but better than it was... 
     1552      ! 
     1553      ! clem: this formulation is certainly wrong... but better than it was before... 
    15571554      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
    15581555         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     
    15701567         qns_ice(:,:,:) = zqns_ice(:,:,:) 
    15711568      ENDIF 
    1572  
     1569      ! 
    15731570#endif 
    1574  
    15751571      !                                                      ! ========================= ! 
    15761572      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr) 
     
    16811677      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    16821678 
    1683       CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
    1684       CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
    1685       ! 
    1686       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
     1679      CALL wrk_dealloc( jpi,jpj,       zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1680      CALL wrk_dealloc( jpi,jpj,jpl,   zqns_ice, zqsr_ice, zdqns_ice ) 
     1681      ! 
     1682      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_flx') 
    16871683      ! 
    16881684   END SUBROUTINE sbc_cpl_ice_flx 
     
    17071703      !!---------------------------------------------------------------------- 
    17081704      ! 
    1709       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_snd') 
    1710       ! 
    1711       CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    1712       CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
     1705      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_snd') 
     1706      ! 
     1707      CALL wrk_alloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     1708      CALL wrk_alloc( jpi,jpj,jpl,   ztmp3, ztmp4 ) 
    17131709 
    17141710      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
     
    20192015      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
    20202016 
    2021       CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    2022       CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
    2023       ! 
    2024       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_snd') 
     2017      CALL wrk_dealloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     2018      CALL wrk_dealloc( jpi,jpj,jpl,   ztmp3, ztmp4 ) 
     2019      ! 
     2020      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_snd') 
    20252021      ! 
    20262022   END SUBROUTINE sbc_cpl_snd 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r5845 r6004  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   sbc_fwb      : freshwater budget for global ocean configurations 
    15    !!                  in free surface and forced mode 
    16    !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE sbc_oce         ! surface ocean boundary condition 
    20    USE phycst          ! physical constants 
    21    USE sbcrnf          ! ocean runoffs 
    22    USE sbcisf          ! ice shelf melting contribution 
    23    USE sbcssr          ! SS damping terms 
    24    USE in_out_manager  ! I/O manager 
    25    USE lib_mpp         ! distribued memory computing library 
    26    USE wrk_nemo        ! work arrays 
    27    USE timing          ! Timing 
    28    USE lbclnk          ! ocean lateral boundary conditions 
    29    USE lib_fortran 
     14   !!   sbc_fwb       : freshwater budget for global ocean configurations (free surface & forced mode) 
     15   !!---------------------------------------------------------------------- 
     16   USE oce            ! ocean dynamics and tracers 
     17   USE dom_oce        ! ocean space and time domain 
     18   USE sbc_oce        ! surface ocean boundary condition 
     19   USE phycst         ! physical constants 
     20   USE sbcrnf         ! ocean runoffs 
     21   USE sbcisf         ! ice shelf melting contribution 
     22   USE sbcssr         ! Sea-Surface damping terms 
     23   ! 
     24   USE in_out_manager ! I/O manager 
     25   USE lib_mpp        ! distribued memory computing library 
     26   USE wrk_nemo       ! work arrays 
     27   USE timing         ! Timing 
     28   USE lbclnk         ! ocean lateral boundary conditions 
     29   USE lib_fortran    !  
    3030 
    3131   IMPLICIT NONE 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5845 r6004  
    2525   USE thd_ice         ! LIM-3: thermodynamical variables 
    2626   USE dom_ice         ! LIM-3: ice domain 
    27  
     27   ! 
    2828   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2929   USE sbc_ice         ! Surface boundary condition: ice   fields 
     
    3232   USE sbccpl          ! Surface boundary condition: coupled interface 
    3333   USE albedo          ! ocean & ice albedo 
    34  
     34   ! 
    3535   USE phycst          ! Define parameters for the routines 
    3636   USE eosbn2          ! equation of state 
     
    4747   USE limupdate2      ! update of global variables 
    4848   USE limvar          ! Ice variables switch 
    49  
     49   USE limctl          !  
    5050   USE limmsh          ! LIM mesh 
    5151   USE limistate       ! LIM initial state 
    5252   USE limthd_sal      ! LIM ice thermodynamics: salinity 
    53  
     53   ! 
    5454   USE c1d             ! 1D vertical configuration 
     55   USE in_out_manager  ! I/O manager 
     56   USE iom             ! I/O manager library 
     57   USE prtctl          ! Print control 
     58   USE lib_fortran     !  
    5559   USE lbclnk          ! lateral boundary condition - MPP link 
    5660   USE lib_mpp         ! MPP library 
    5761   USE wrk_nemo        ! work arrays 
    5862   USE timing          ! Timing 
    59    USE iom             ! I/O manager library 
    60    USE in_out_manager  ! I/O manager 
    61    USE prtctl          ! Print control 
    62    USE lib_fortran     !  
    63    USE limctl 
    6463 
    6564#if defined key_bdy  
     
    8180   !!---------------------------------------------------------------------- 
    8281CONTAINS 
    83  
    84    !!====================================================================== 
    8582 
    8683   SUBROUTINE sbc_ice_lim( kt, kblk ) 
     
    269266      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
    270267      ! 
    271                                        ! Open the reference and configuration namelist files and namelist output file  
     268      !                                ! Open the reference and configuration namelist files and namelist output file  
    272269      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )  
    273270      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    274271      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 
    275  
     272      ! 
    276273      CALL ice_run                     ! set some ice run parameters 
    277274      ! 
     
    347344      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice 
    348345      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 
    349 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 
    350  
     346901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 
     347      ! 
    351348      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice 
    352349      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 
    353 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 
    354       IF(lwm) WRITE ( numoni, namicerun ) 
    355       ! 
     350902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 
     351      IF(lwm) WRITE( numoni, namicerun ) 
    356352      ! 
    357353      IF(lwp) THEN                        ! control print 
     
    404400      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice 
    405401      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 
    406 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
    407  
     402903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
     403      ! 
    408404      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice 
    409405      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 
    410 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
    411       IF(lwm) WRITE ( numoni, namiceitd ) 
    412       ! 
     406904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
     407      IF(lwm) WRITE( numoni, namiceitd ) 
    413408      ! 
    414409      IF(lwp) THEN                        ! control print 
     
    416411         WRITE(numout,*) 'ice_itd : ice cat distribution' 
    417412         WRITE(numout,*) ' ~~~~~~' 
    418          WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd 
    419          WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 
     413         WRITE(numout,*) '   shape of ice categories distribution                     nn_catbnd = ', nn_catbnd 
     414         WRITE(numout,*) '   mean ice thickness in the domain (used if nn_catbnd=2)  rn_himean = ', rn_himean 
    420415      ENDIF 
    421  
     416      ! 
    422417      !---------------------------------- 
    423418      !- Thickness categories boundaries  
     
    426421      IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
    427422      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    428  
     423      ! 
    429424      hi_max(:) = 0._wp 
    430  
    431       SELECT CASE ( nn_catbnd  )        
    432                                    !---------------------- 
    433          CASE (1)                  ! tanh function (CICE) 
    434                                    !---------------------- 
     425      ! 
     426      SELECT CASE ( nn_catbnd  )    ! type of ice categories distribution 
     427      ! 
     428      CASE (1)                            !==  tanh function (CICE)  ==! 
    435429         zc1 =  3._wp / REAL( jpl, wp ) 
    436430         zc2 = 10._wp * zc1 
    437431         zc3 =  3._wp 
    438  
    439432         DO jl = 1, jpl 
    440433            zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 
    441434            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 
    442435         END DO 
    443  
    444                                    !---------------------- 
    445          CASE (2)                  ! h^(-alpha) function 
    446                                    !---------------------- 
    447          zalpha = 0.05             ! exponent of the transform function 
    448  
    449          zhmax  = 3.*rn_himean 
    450  
     436         ! 
     437      CASE (2)                            !==  h^(-alpha) function  ==! 
     438         zalpha = 0.05_wp 
     439         zhmax  = 3._wp * rn_himean 
    451440         DO jl = 1, jpl  
    452441            znum = jpl * ( zhmax+1 )**zalpha 
    453             zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl 
     442            zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 
    454443            hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 
    455444         END DO 
    456  
     445         ! 
    457446      END SELECT 
    458  
    459       DO jl = 1, jpl 
     447      ! 
     448      DO jl = 1, jpl                ! mean thickness by category 
    460449         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 
    461450      END DO 
    462  
    463       ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 
    464       hi_max(jpl) = 99._wp 
    465  
     451      ! 
     452      hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 
     453      ! 
    466454      IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 
    467455      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 
     
    470458 
    471459    
    472    SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
     460   SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice ,    & 
     461      &                    pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    473462      !!--------------------------------------------------------------------- 
    474463      !!                  ***  ROUTINE ice_lim_flx  *** 
     
    482471      !!--------------------------------------------------------------------- 
    483472      INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ;  
    484                                                                 ! =1 average and redistribute ; =2 redistribute 
     473      !                                                         ! =1 average and redistribute ; =2 redistribute 
    485474      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature  
    486475      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo 
     
    502491      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 
    503492      !!---------------------------------------------------------------------- 
    504  
     493      ! 
    505494      IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx') 
    506       ! 
    507495      ! 
    508496      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
     
    528516         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    529517      END SELECT 
    530  
     518      ! 
    531519      SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==! 
    532520      CASE( 1 , 2 ) 
     
    547535      ! 
    548536   END SUBROUTINE ice_lim_flx 
     537 
    549538 
    550539   SUBROUTINE sbc_lim_bef 
     
    563552      u_ice_b(:,:)     = u_ice(:,:) 
    564553      v_ice_b(:,:)     = v_ice(:,:) 
    565        
     554      !       
    566555   END SUBROUTINE sbc_lim_bef 
     556 
    567557 
    568558   SUBROUTINE sbc_lim_diag0 
     
    579569      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
    580570      sfx_res(:,:) = 0._wp 
    581        
     571      ! 
    582572      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
    583573      wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     
    586576      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
    587577      wfx_spr(:,:) = 0._wp   ;    
    588        
     578      ! 
    589579      hfx_thd(:,:) = 0._wp   ;    
    590580      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
     
    595585      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
    596586      hfx_err_dif(:,:) = 0._wp   ; 
    597  
     587      ! 
    598588      afx_tot(:,:) = 0._wp   ; 
    599589      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
    600  
     590      ! 
    601591      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ; 
    602592      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ; 
    603        
     593      ! 
    604594   END SUBROUTINE sbc_lim_diag0 
    605595 
     
    633623   END FUNCTION fice_ice_ave 
    634624 
    635  
    636625#else 
    637626   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5883 r6004  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   sbc_rnf      : monthly runoffs read in a NetCDF file 
    15    !!   sbc_rnf_init : runoffs initialisation 
    16    !!   rnf_mouth    : set river mouth mask 
     14   !!   sbc_rnf       : monthly runoffs read in a NetCDF file 
     15   !!   sbc_rnf_init  : runoffs initialisation 
     16   !!   rnf_mouth     : set river mouth mask 
    1717   !!---------------------------------------------------------------------- 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE phycst          ! physical constants 
    20    USE sbc_oce         ! surface boundary condition variables 
    21    USE sbcisf          ! PM we could remove it I think 
    22    USE closea          ! closed seas 
    23    USE fldread         ! read input field at current time step 
    24    USE in_out_manager  ! I/O manager 
    25    USE iom             ! I/O module 
    26    USE lib_mpp         ! MPP library 
    27    USE eosbn2 
    28    USE wrk_nemo        ! Memory allocation 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE phycst         ! physical constants 
     20   USE sbc_oce        ! surface boundary condition variables 
     21   USE sbcisf         ! PM we could remove it I think 
     22   USE closea         ! closed seas 
     23   USE eosbn2         ! Equation Of State 
     24   ! 
     25   USE in_out_manager ! I/O manager 
     26   USE fldread        ! read input field at current time step 
     27   USE iom            ! I/O module 
     28   USE lib_mpp        ! MPP library 
     29   USE wrk_nemo       ! Memory allocation 
    2930 
    3031   IMPLICIT NONE 
    3132   PRIVATE 
    3233 
    33    PUBLIC   sbc_rnf       ! routine called in sbcmod module 
    34    PUBLIC   sbc_rnf_div   ! routine called in divhor module 
    35    PUBLIC   sbc_rnf_alloc ! routine called in sbcmod module 
    36    PUBLIC   sbc_rnf_init  ! routine called in sbcmod module 
     34   PUBLIC   sbc_rnf       ! called in sbcmod module 
     35   PUBLIC   sbc_rnf_div   ! called in divhor module 
     36   PUBLIC   sbc_rnf_alloc ! called in sbcmod module 
     37   PUBLIC   sbc_rnf_init  ! called in sbcmod module 
    3738    
    38    !                                                     !!* namsbc_rnf namelist * 
    39    CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files 
     39   !                                                !!* namsbc_rnf namelist * 
     40   CHARACTER(len=100)         ::   cn_dir            !: Root directory for location of rnf files 
    4041   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file 
    41    LOGICAL                    ::   ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation 
    42    REAL(wp)                   ::   rn_rnf_max        !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true ) 
    43    REAL(wp)                   ::   rn_dep_max        !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 
    44    INTEGER                    ::   nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 
    45    LOGICAL                    ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file 
    46    LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file 
    47    TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read 
    48    TYPE(FLD_N)                ::   sn_cnf          !: information about the runoff mouth file to be read 
    49    TYPE(FLD_N)                ::   sn_s_rnf        !: information about the salinities of runoff file to be read 
    50    TYPE(FLD_N)                ::   sn_t_rnf        !: information about the temperatures of runoff file to be read 
    51    TYPE(FLD_N)                ::   sn_dep_rnf      !: information about the depth which river inflow affects 
    52    LOGICAL           , PUBLIC ::   ln_rnf_mouth    !: specific treatment in mouths vicinity 
    53    REAL(wp)                   ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used 
    54    REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s] 
    55    REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff 
    56  
    57    LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis 
    58  
    59    INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
     42   LOGICAL                    ::      ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation 
     43   REAL(wp)                   ::      rn_rnf_max        !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T) 
     44   REAL(wp)                   ::      rn_dep_max        !: depth over which runoffs is spread       (ln_rnf_depth_ini =T) 
     45   INTEGER                    ::      nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 
     46   LOGICAL                    ::   ln_rnf_tem        !: temperature river runoffs attribute specified in a file 
     47   LOGICAL           , PUBLIC ::   ln_rnf_sal        !: salinity    river runoffs attribute specified in a file 
     48   TYPE(FLD_N)       , PUBLIC ::   sn_rnf            !: information about the runoff file to be read 
     49   TYPE(FLD_N)                ::   sn_cnf            !: information about the runoff mouth file to be read 
     50   TYPE(FLD_N)                ::   sn_s_rnf          !: information about the salinities of runoff file to be read 
     51   TYPE(FLD_N)                ::   sn_t_rnf          !: information about the temperatures of runoff file to be read 
     52   TYPE(FLD_N)                ::   sn_dep_rnf        !: information about the depth which river inflow affects 
     53   LOGICAL           , PUBLIC ::   ln_rnf_mouth      !: specific treatment in mouths vicinity 
     54   REAL(wp)                   ::   rn_hrnf           !: runoffs, depth over which enhanced vertical mixing is used 
     55   REAL(wp)          , PUBLIC ::   rn_avt_rnf        !: runoffs, value of the additional vertical mixing coef. [m2/s] 
     56   REAL(wp)                   ::   rn_rfact          !: multiplicative factor for runoff 
     57 
     58   LOGICAL , PUBLIC ::   l_rnfcpl = .false.   !: runoffs recieved from oasis 
     59   INTEGER , PUBLIC ::   nkrnf = 0            !: nb of levels over which Kz is increased at river mouths 
     60    
    6061   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.) 
    6162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.) 
     
    211212      ! 
    212213      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    213          IF( .NOT.ln_linssh ) THEN     ! variable volume case 
     214         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow 
     215            DO jj = 1, jpj 
     216               DO ji = 1, jpi 
     217                  DO jk = 1, nk_rnf(ji,jj) 
     218                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj) 
     219                  END DO 
     220               END DO 
     221            END DO 
     222         ELSE                    !* variable volume case 
    214223            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
    215224               DO ji = 1, jpi 
     
    224233               END DO 
    225234            END DO 
    226          ELSE                          ! constant volume case : just apply the runoff input flow 
    227             DO jj = 1, jpj 
    228                DO ji = 1, jpi 
    229                   DO jk = 1, nk_rnf(ji,jj) 
    230                      phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj) 
    231                   END DO 
    232                END DO 
    233             END DO 
    234235         ENDIF 
    235236      ELSE                       !==   runoff put only at the surface   ==! 
    236          IF( .NOT.ln_linssh ) THEN              ! variable volume case 
    237             h_rnf(:,:) = e3t_n(:,:,1)   ! recalculate h_rnf to be depth of top box 
    238          ENDIF 
     237         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box 
    239238         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 
    240239      ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r5866 r6004  
    66   !! History :  9.0  ! 2006-07  (G. Madec)  Original code 
    77   !!            3.3  ! 2010-10  (C. Bricaud, G. Madec)  add the Patm forcing for sea-ice 
    8    !!---------------------------------------------------------------------- 
    9  
    10    !!---------------------------------------------------------------------- 
    11    !!   sbc_ssm        : calculate sea surface mean currents, temperature,   
    12    !!                    and salinity over nn_fsbc time-step 
    13    !!---------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and tracers 
    15    USE dom_oce         ! ocean space and time domain 
    16    USE sbc_oce         ! surface boundary condition: ocean fields 
    17    USE sbcapr          ! surface boundary condition: atmospheric pressure 
    18    USE eosbn2          ! equation of state and related derivatives 
     8   !!            3.7  ! 2015-11  (G. Madec)  non linear free surface by default: e3t_m always computed 
     9   !!---------------------------------------------------------------------- 
     10 
     11   !!---------------------------------------------------------------------- 
     12   !!   sbc_ssm       : calculate sea surface mean currents, temperature,   
     13   !!                   and salinity over nn_fsbc time-step 
     14   !!---------------------------------------------------------------------- 
     15   USE oce            ! ocean dynamics and tracers 
     16   USE dom_oce        ! ocean space and time domain 
     17   USE sbc_oce        ! surface boundary condition: ocean fields 
     18   USE sbcapr         ! surface boundary condition: atmospheric pressure 
     19   USE eosbn2         ! equation of state and related derivatives 
    1920   ! 
    20    USE in_out_manager  ! I/O manager 
    21    USE prtctl          ! Print control 
    22    USE iom             ! IOM library 
     21   USE in_out_manager ! I/O manager 
     22   USE prtctl         ! Print control 
     23   USE iom            ! IOM library 
    2324 
    2425   IMPLICIT NONE 
    2526   PRIVATE 
    2627 
    27    PUBLIC   sbc_ssm         ! routine called by step.F90 
    28    PUBLIC   sbc_ssm_init    ! routine called by sbcmod.F90 
    29  
    30    LOGICAL, SAVE  ::   l_ssm_mean = .FALSE.       ! keep track of whether means have been read from restart file 
     28   PUBLIC   sbc_ssm        ! routine called by step.F90 
     29   PUBLIC   sbc_ssm_init   ! routine called by sbcmod.F90 
     30 
     31   LOGICAL, SAVE ::   l_ssm_mean = .FALSE.   ! keep track of whether means have been read from restart file 
    3132    
    3233   !!---------------------------------------------------------------------- 
     
    5657      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 
    5758      !!--------------------------------------------------------------------- 
    58  
     59      ! 
    5960      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
    6061      DO jj = 1, jpj 
     
    7879         ENDIF 
    7980         ! 
    80          IF( .NOT.ln_linssh )   e3t_m(:,:) = e3t_n(:,:,1) 
     81         e3t_m(:,:) = e3t_n(:,:,1) 
    8182         ! 
    8283         frq_m(:,:) = fraqsr_1lev(:,:) 
     
    100101            ENDIF 
    101102            ! 
    102             IF( .NOT.ln_linssh )   e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
     103            e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
    103104            ! 
    104105            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
     
    111112            sss_m(:,:) = 0._wp 
    112113            ssh_m(:,:) = 0._wp 
    113             IF( .NOT.ln_linssh )   e3t_m(:,:) = 0._wp 
     114            e3t_m(:,:) = 0._wp 
    114115            frq_m(:,:) = 0._wp 
    115116         ENDIF 
     
    128129         ENDIF 
    129130         ! 
    130          IF( .NOT.ln_linssh )   e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
    131          ! 
    132          frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:) 
     131         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
     132         ! 
     133         frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 
    133134 
    134135         !                                                ! ---------------------------------------- ! 
     
    136137            !                                             ! ---------------------------------------- ! 
    137138            zcoef = 1. / REAL( nn_fsbc, wp ) 
    138             sst_m(:,:) = sst_m(:,:) * zcoef           ! mean SST             [Celcius] 
    139             sss_m(:,:) = sss_m(:,:) * zcoef           ! mean SSS             [psu] 
    140             ssu_m(:,:) = ssu_m(:,:) * zcoef           ! mean suface current  [m/s] 
    141             ssv_m(:,:) = ssv_m(:,:) * zcoef           ! 
    142             ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m] 
    143             IF( .NOT.ln_linssh )   e3t_m(:,:) = e3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
    144             frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     139            sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celcius] 
     140            sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu] 
     141            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 
     142            ssv_m(:,:) = ssv_m(:,:) * zcoef     ! 
     143            ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
     144            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
     145            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    145146            ! 
    146147         ENDIF 
     
    159160            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  ) 
    160161            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
    161             IF( .NOT.ln_linssh )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
     162            CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
    162163            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  ) 
    163164            ! 
     
    172173         CALL iom_put( 'sss_m', sss_m ) 
    173174         CALL iom_put( 'ssh_m', ssh_m ) 
    174          IF( .NOT.ln_linssh )   CALL iom_put( 'e3t_m', e3t_m ) 
     175         CALL iom_put( 'e3t_m', e3t_m ) 
    175176         CALL iom_put( 'frq_m', frq_m ) 
    176177      ENDIF 
    177178      ! 
    178179   END SUBROUTINE sbc_ssm 
     180 
    179181 
    180182   SUBROUTINE sbc_ssm_init 
     
    186188      !! ** Action  : - read parameters 
    187189      !!---------------------------------------------------------------------- 
    188       REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
     190      REAL(wp) ::   zcoef, zf_sbc   ! local scalar 
    189191      !!---------------------------------------------------------------------- 
    190  
     192      ! 
    191193      IF( nn_fsbc == 1 ) THEN 
    192194         ! 
     
    203205         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 
    204206            l_ssm_mean = .TRUE. 
    205             CALL iom_get( numror               , 'nn_fsbc', zf_sbc )   ! sbc frequency of previous run 
    206             CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )   ! sea surface mean velocity    (T-point) 
    207             CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )   !   "         "    velocity    (V-point) 
    208             CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )   !   "         "    temperature (T-point) 
    209             CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point) 
    210             CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point) 
    211             IF( .NOT.ln_linssh )   CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 
     207            CALL iom_get( numror               , 'nn_fsbc', zf_sbc )    ! sbc frequency of previous run 
     208            CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )    ! sea surface mean velocity    (U-point) 
     209            CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )    !   "         "    velocity    (V-point) 
     210            CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )    !   "         "    temperature (T-point) 
     211            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )    !   "         "    salinity    (T-point) 
     212            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )    !   "         "    height      (T-point) 
     213            CALL iom_get( numror, jpdom_autoglo, 'e3t_m'  , e3t_m  )    ! 1st level thickness          (T-point) 
    212214            ! fraction of solar net radiation absorbed in 1st T level 
    213215            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 
     
    226228               sss_m(:,:) = zcoef * sss_m(:,:) 
    227229               ssh_m(:,:) = zcoef * ssh_m(:,:) 
    228                IF( .NOT.ln_linssh )   e3t_m(:,:) = zcoef * e3t_m(:,:) 
     230               e3t_m(:,:) = zcoef * e3t_m(:,:) 
    229231               frq_m(:,:) = zcoef * frq_m(:,:) 
    230232            ELSE 
     
    242244         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    243245         ENDIF 
    244          sss_m(:,:) = tsn(:,:,1,jp_sal) 
    245          ssh_m(:,:) = sshn(:,:) 
    246          IF( .NOT.ln_linssh )   e3t_m(:,:) = e3t_n(:,:,1) 
     246         sss_m(:,:) = tsn  (:,:,1,jp_sal) 
     247         ssh_m(:,:) = sshn (:,:) 
     248         e3t_m(:,:) = e3t_n(:,:,1) 
    247249         frq_m(:,:) = 1._wp 
    248250         ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r5845 r6004  
    1919   ! 
    2020   USE fldread        ! read input fields 
     21   USE in_out_manager ! I/O manager 
    2122   USE iom            ! I/O manager 
    22    USE in_out_manager ! I/O manager 
    2323   USE lib_mpp        ! distribued memory computing library 
    2424   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

    r5215 r6004  
    66   !! History :  9.0  !  2007  (O. Le Galloudec)  Original code 
    77   !!---------------------------------------------------------------------- 
    8    USE oce             ! ocean dynamics and tracers variables 
    9    USE dom_oce         ! ocean space and time domain 
    10    USE phycst 
    11    USE daymod 
    12    USE dynspg_oce 
    13    USE tideini 
     8   USE oce            ! ocean dynamics and tracers variables 
     9   USE dom_oce        ! ocean space and time domain 
     10   USE phycst         ! physical constant 
     11   USE daymod         ! calandar 
     12   USE tideini        !  
    1413   ! 
    15    USE iom 
    16    USE in_out_manager  ! I/O units 
    17    USE ioipsl          ! NetCDF IPSL library 
    18    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     14   USE in_out_manager ! I/O units 
     15   USE iom            ! xIOs server 
     16   USE ioipsl         ! NetCDF IPSL library 
     17   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    1918 
    2019   IMPLICIT NONE 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    r5215 r6004  
    66   !! History :  1.0  !  2007  (O. Le Galloudec)  Original code 
    77   !!---------------------------------------------------------------------- 
    8    USE oce             ! ocean dynamics and tracers variables 
    9    USE dom_oce         ! ocean space and time domain 
    10    USE phycst 
    11    USE daymod 
    12    USE dynspg_oce 
    13    USE tide_mod 
     8   USE oce            ! ocean dynamics and tracers variables 
     9   USE dom_oce        ! ocean space and time domain 
     10   USE phycst         ! physical constant 
     11   USE daymod         ! calandar 
     12   USE tide_mod       !  
    1413   ! 
    15    USE iom 
    16    USE in_out_manager  ! I/O units 
    17    USE ioipsl          ! NetCDF IPSL library 
    18    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     14   USE in_out_manager ! I/O units 
     15   USE iom            ! xIOs server 
     16   USE ioipsl         ! NetCDF IPSL library 
     17   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    1918 
    2019   IMPLICIT NONE 
     
    2827   LOGICAL , PUBLIC ::   ln_tide_pot     !: 
    2928   LOGICAL , PUBLIC ::   ln_tide_ramp    !: 
    30    INTEGER , PUBLIC ::   nb_harmo                 !: 
    31    INTEGER , PUBLIC ::   kt_tide                  !: 
    32    REAL(wp), PUBLIC ::   rdttideramp              !: 
     29   INTEGER , PUBLIC ::   nb_harmo        !: 
     30   INTEGER , PUBLIC ::   kt_tide         !: 
     31   REAL(wp), PUBLIC ::   rdttideramp     !: 
    3332    
    3433   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !: 
     
    4140CONTAINS 
    4241    
    43   SUBROUTINE tide_init ( kt ) 
    44     !!---------------------------------------------------------------------- 
    45     !!                 ***  ROUTINE tide_init  *** 
    46     !!----------------------------------------------------------------------       
    47     !! * Local declarations 
    48     INTEGER  :: ji, jk 
    49     INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    50     CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 
    51     INTEGER  ::   ios                 ! Local integer output status for namelist read 
    52     ! 
    53     NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname 
    54     !!---------------------------------------------------------------------- 
    55  
    56     IF ( kt == nit000 ) THEN 
    57        ! 
    58        IF(lwp) THEN 
    59           WRITE(numout,*) 
    60           WRITE(numout,*) 'tide_init : Initialization of the tidal components' 
    61           WRITE(numout,*) '~~~~~~~~~ ' 
    62        ENDIF 
    63        ! 
    64        CALL tide_init_Wave 
    65        ! 
    66        ! Read Namelist nam_tide 
    67        REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides 
    68        READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 
    69 901    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 
    70  
    71        REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides 
    72        READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 
    73 902    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 
    74        IF(lwm) WRITE ( numond, nam_tide ) 
    75        ! 
    76        nb_harmo=0 
    77        DO jk = 1, jpmax_harmo 
    78           DO ji = 1,jpmax_harmo 
    79              IF( TRIM(clname(jk)) == Wave(ji)%cname_tide )   nb_harmo = nb_harmo + 1 
    80           END DO 
    81        END DO 
    82        !        
    83        ! Ensure that tidal components have been set in namelist_cfg 
    84        IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 
    85        ! 
    86        IF(lwp) THEN 
    87           WRITE(numout,*) '   Namelist nam_tide' 
    88           WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  =', ln_tide_pot 
    89           WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo 
    90           WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp  
    91           WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp 
    92        ENDIF 
    93        IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   & 
    94           &   CALL ctl_stop('rdttideramp must be lower than run duration') 
    95        IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 
    96           &   CALL ctl_stop('rdttideramp must be positive') 
    97        ! 
    98        IF( .NOT. lk_dynspg_ts )   CALL ctl_warn( 'sbc_tide : use of time splitting is recommended' ) 
    99        ! 
    100        ALLOCATE( ntide(nb_harmo) ) 
    101        DO jk = 1, nb_harmo 
    102           DO ji = 1, jpmax_harmo 
    103              IF( TRIM(clname(jk)) .eq. Wave(ji)%cname_tide ) THEN 
    104                 ntide(jk) = ji 
    105                 EXIT 
    106              END IF 
    107           END DO 
    108        END DO 
    109        ! 
    110        ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   & 
    111           &      utide     (nb_harmo), ftide     (nb_harmo)  ) 
    112        kt_tide = kt 
    113        ! 
     42   SUBROUTINE tide_init 
     43      !!---------------------------------------------------------------------- 
     44      !!                 ***  ROUTINE tide_init  *** 
     45      !!----------------------------------------------------------------------       
     46      INTEGER  :: ji, jk 
     47      CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 
     48      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     49      ! 
     50      NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname 
     51      !!---------------------------------------------------------------------- 
     52      ! 
     53      IF(lwp) THEN 
     54         WRITE(numout,*) 
     55         WRITE(numout,*) 'tide_init : Initialization of the tidal components' 
     56         WRITE(numout,*) '~~~~~~~~~ ' 
    11457      ENDIF 
     58      ! 
     59      CALL tide_init_Wave 
     60      ! 
     61      ! Read Namelist nam_tide 
     62      REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides 
     63      READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 
     64901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 
     65      ! 
     66      REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides 
     67      READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 
     68902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 
     69      IF(lwm) WRITE ( numond, nam_tide ) 
     70      ! 
     71      nb_harmo=0 
     72      DO jk = 1, jpmax_harmo 
     73         DO ji = 1,jpmax_harmo 
     74            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide )   nb_harmo = nb_harmo + 1 
     75         END DO 
     76      END DO 
     77      !        
     78      ! Ensure that tidal components have been set in namelist_cfg 
     79      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 
     80      ! 
     81      IF(lwp) THEN 
     82         WRITE(numout,*) '   Namelist nam_tide' 
     83         WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  =', ln_tide_pot 
     84         WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo 
     85         WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp  
     86         WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp 
     87      ENDIF 
     88      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   & 
     89         &   CALL ctl_stop('rdttideramp must be lower than run duration') 
     90      IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 
     91         &   CALL ctl_stop('rdttideramp must be positive') 
     92      ! 
     93      ALLOCATE( ntide(nb_harmo) ) 
     94      DO jk = 1, nb_harmo 
     95         DO ji = 1, jpmax_harmo 
     96            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN 
     97               ntide(jk) = ji 
     98               EXIT 
     99            ENDIF 
     100         END DO 
     101      END DO 
     102      ! 
     103      ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   & 
     104         &      utide     (nb_harmo), ftide     (nb_harmo)  ) 
     105      kt_tide = nit000 
    115106      ! 
    116107   END SUBROUTINE tide_init 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90

    r5215 r6004  
    44   !! Initialization of tidal forcing 
    55   !!====================================================================== 
    6    !! History :  9.0  !  07  (O. Le Galloudec)  Original code 
     6   !! History :  9.0  !  2007  (O. Le Galloudec)  Original code 
    77   !!---------------------------------------------------------------------- 
    88#if defined key_tide 
     
    1010   !!   'key_tide' :                                        tidal potential 
    1111   !!---------------------------------------------------------------------- 
    12    !!   upd_tide       : update tidal potential 
     12   !!   upd_tide      : update tidal potential 
    1313   !!---------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and tracers variables 
    15    USE dom_oce         ! ocean space and time domain 
    16    USE in_out_manager  ! I/O units 
    17    USE phycst          ! physical constant 
    18    USE sbctide         ! tide potential variable 
    19    USE tideini, ONLY: ln_tide_ramp, rdttideramp 
     14   USE oce            ! ocean dynamics and tracers variables 
     15   USE dom_oce        ! ocean space and time domain 
     16   USE in_out_manager ! I/O units 
     17   USE phycst         ! physical constant 
     18   USE sbctide        ! tide potential variable 
     19   USE tideini  , ONLY:  ln_tide_ramp, rdttideramp 
    2020 
    2121   IMPLICIT NONE 
     
    4545      INTEGER, INTENT(in), OPTIONAL ::   kbaro   ! number of sub-time-step           (lk_dynspg_ts=T only) 
    4646      INTEGER, INTENT(in), OPTIONAL ::   koffset ! time offset in number  
    47                                                  ! of sub-time-steps                 (lk_dynspg_ts=T only) 
     47      !                                          ! of sub-time-steps                 (lk_dynspg_ts=T only) 
    4848      ! 
    4949      INTEGER  ::   joffset      ! local integer 
     
    9393    WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt 
    9494  END SUBROUTINE upd_tide 
    95  
    9695#endif 
    9796 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5845 r6004  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  eosbn2  *** 
    4    !! Ocean diagnostic variable : equation of state - in situ and potential density 
    5    !!                                               - Brunt-Vaisala frequency 
     4   !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency 
    65   !!============================================================================== 
    76   !! History :  OPA  ! 1989-03  (O. Marti)  Original code 
     
    2625 
    2726   !!---------------------------------------------------------------------- 
    28    !!   eos            : generic interface of the equation of state 
    29    !!   eos_insitu     : Compute the in situ density 
    30    !!   eos_insitu_pot : Compute the insitu and surface referenced potential volumic mass 
    31    !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    32    !!   bn2            : Compute the Brunt-Vaisala frequency 
    33    !!   eos_rab        : generic interface of in situ thermal/haline expansion ratio  
    34    !!   eos_rab_3d     : compute in situ thermal/haline expansion ratio 
    35    !!   eos_rab_2d     : compute in situ thermal/haline expansion ratio for 2d fields 
    36    !!   eos_fzp_2d     : freezing temperature for 2d fields 
    37    !!   eos_fzp_0d     : freezing temperature for scalar 
    38    !!   eos_init       : set eos parameters (namelist) 
     27   !!   eos           : generic interface of the equation of state 
     28   !!   eos_insitu    : Compute the in situ density 
     29   !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass 
     30   !!   eos_insitu_2d : Compute the in situ density for 2d fields 
     31   !!   bn2           : Compute the Brunt-Vaisala frequency 
     32   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio  
     33   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio 
     34   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields 
     35   !!   eos_fzp_2d    : freezing temperature for 2d fields 
     36   !!   eos_fzp_0d    : freezing temperature for scalar 
     37   !!   eos_init      : set eos parameters (namelist) 
    3938   !!---------------------------------------------------------------------- 
    40    USE dom_oce         ! ocean space and time domain 
    41    USE phycst          ! physical constants 
     39   USE dom_oce        ! ocean space and time domain 
     40   USE phycst         ! physical constants 
     41   USE stopar         ! Stochastic T/S fluctuations 
     42   USE stopts         ! Stochastic T/S fluctuations 
    4243   ! 
    43    USE in_out_manager  ! I/O manager 
    44    USE lib_mpp         ! MPP library 
    45    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    46    USE prtctl          ! Print control 
    47    USE wrk_nemo        ! Memory Allocation 
     44   USE in_out_manager ! I/O manager 
     45   USE lib_mpp        ! MPP library 
     46   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     47   USE prtctl         ! Print control 
     48   USE wrk_nemo       ! Memory Allocation 
    4849   USE lbclnk         ! ocean lateral boundary conditions 
    49    USE timing          ! Timing 
    50    USE stopar          ! Stochastic T/S fluctuations 
    51    USE stopts          ! Stochastic T/S fluctuations 
     50   USE timing         ! Timing 
    5251 
    5352   IMPLICIT NONE 
    5453   PRIVATE 
    5554 
    56    !                   !! * Interface 
     55   !                  !! * Interface 
    5756   INTERFACE eos 
    5857      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
     
    7574   PUBLIC   eos_init       ! called by istate module 
    7675 
    77    !                                !!* Namelist (nameos) * 
     76   !                               !!** Namelist nameos ** 
    7877   INTEGER , PUBLIC ::   nn_eos     ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    7978   LOGICAL , PUBLIC ::   ln_useCT   ! determine if eos_pt_from_ct is used to compute sst_m 
    8079 
    81    !                                   !!!  simplified eos coefficients 
    82    ! default value: Vallis 2006 
     80   !                               !!!  simplified eos coefficients (default value: Vallis 2006) 
    8381   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
    8482   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r5883 r6004  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   tra_adv_cen : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order) 
    11    !!                 NB: on the vertical it is actually a 4th order COMPACT scheme which is used 
    12    !!---------------------------------------------------------------------- 
    13    USE oce, ONLY: tsn ! now ocean temperature and salinity 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE eosbn2          ! equation of state 
    16    USE traadv_fct      ! acces to routine interp_4th_cpt  
    17    USE trd_oce         ! trends: ocean variables 
    18    USE trdtra          ! trends manager: tracers  
    19    USE diaptr          ! poleward transport diagnostics 
     10   !!   tra_adv_cen   : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order) 
     11   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used 
     12   !!---------------------------------------------------------------------- 
     13   USE oce      , ONLY: tsn ! now ocean temperature and salinity 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE eosbn2         ! equation of state 
     16   USE traadv_fct     ! acces to routine interp_4th_cpt  
     17   USE trd_oce        ! trends: ocean variables 
     18   USE trdtra         ! trends manager: tracers  
     19   USE diaptr         ! poleward transport diagnostics 
    2020   ! 
    21    USE in_out_manager  ! I/O manager 
    22    USE iom             ! IOM library 
    23    USE trc_oce         ! share passive tracers/Ocean variables 
    24    USE lib_mpp         ! MPP library 
    25    USE wrk_nemo        ! Memory Allocation 
    26    USE timing          ! Timing 
     21   USE in_out_manager ! I/O manager 
     22   USE iom            ! IOM library 
     23   USE trc_oce        ! share passive tracers/Ocean variables 
     24   USE lib_mpp        ! MPP library 
     25   USE wrk_nemo       ! Memory Allocation 
     26   USE timing         ! Timing 
    2727 
    2828   IMPLICIT NONE 
     
    191191         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    192192         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    193            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    194            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
     193           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     194           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    195195         ENDIF 
    196196         ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r5883 r6004  
    1919   USE trd_oce        ! trends: ocean variables 
    2020   USE trdtra         ! tracers trends 
    21    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    2221   USE diaptr         ! poleward transport diagnostics 
    2322   ! 
     
    290289                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    291290                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) & 
    292                      &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     291                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    293292               END DO 
    294293            END DO 
     
    308307         !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    309308         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    310            IF( jn == jp_tem )  htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) ) 
    311            IF( jn == jp_sal )  str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) ) 
     309           IF( jn == jp_tem )   htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) ) 
     310           IF( jn == jp_sal )   str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) ) 
    312311         ENDIF 
    313312         ! 
     
    536535                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 & 
    537536                        &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    538                         &                         / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     537                        &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    539538                  END DO 
    540539               END DO 
     
    565564                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       & 
    566565                     &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   & 
    567                      &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     566                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    568567               END DO 
    569568            END DO 
     
    668667 
    669668               ! up & down beta terms 
    670                zbt = e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 
     669               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 
    671670               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
    672671               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r5883 r6004  
    2121   USE trd_oce        ! trends: ocean variables 
    2222   USE trdtra         ! tracers trends manager 
    23    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    2423   USE sbcrnf         ! river runoffs 
    2524   USE diaptr         ! poleward transport diagnostics 
     
    122121         ! 
    123122         !                                !-- first guess of the slopes 
    124          zwx(:,:,jpk) = 0.e0                    ! bottom values 
     123         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    125124         zwy(:,:,jpk) = 0._wp   
    126125         DO jk = 1, jpkm1                       ! interior values 
     
    135134         CALL lbc_lnk( zwy, 'V', -1. ) 
    136135         !                                !-- Slopes of tracer 
    137          zslpx(:,:,jpk) = 0._wp                  ! bottom values 
     136         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    138137         zslpy(:,:,jpk) = 0._wp 
    139          DO jk = 1, jpkm1                        ! interior values 
     138         DO jk = 1, jpkm1                       ! interior values 
    140139            DO jj = 2, jpj 
    141140               DO ji = fs_2, jpi   ! vector opt. 
     
    168167                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    169168                  zalpha = 0.5 - z0u 
    170                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     169                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    171170                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
    172171                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
     
    175174                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    176175                  zalpha = 0.5 - z0v 
    177                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 
     176                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt * r1_e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    178177                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
    179178                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
     
    189188                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    190189                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
    191                   &                                   / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     190                  &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    192191               END DO 
    193192           END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5883 r6004  
    2020   USE trd_oce         ! trends: ocean variables 
    2121   USE trdtra          ! trends manager: tracers  
    22    USE dynspg_oce      ! surface pressure gradient variables 
    2322   USE diaptr          ! poleward transport diagnostics 
    2423   ! 
     
    217216            DO jj = 2, jpjm1 
    218217               DO ji = fs_2, fs_jpim1   ! vector opt.   
    219                   zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     218                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    220219                  ! horizontal advective trends 
    221220                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
     
    341340            DO jj = 2, jpjm1 
    342341               DO ji = fs_2, fs_jpim1   ! vector opt.   
    343                   zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     342                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    344343                  ! horizontal advective trends 
    345344                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
     
    412411               DO ji = fs_2, fs_jpim1   ! vector opt. 
    413412                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    414                      &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     413                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    415414               END DO 
    416415            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r5883 r6004  
    1818   USE traadv_fct      ! acces to routine interp_4th_cpt  
    1919   USE trdtra         ! trends manager: tracers  
    20    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    2120   USE diaptr         ! poleward transport diagnostics 
    2221   ! 
     
    164163                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        & 
    165164                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
    166                      &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     165                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    167166               END DO 
    168167            END DO 
     
    217216               DO jj = 2, jpjm1 
    218217                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    219                      ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     218                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    220219                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak  
    221220                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
     
    255254            DO jj = 2, jpjm1  
    256255               DO ji = fs_2, fs_jpim1   ! vector opt.    
    257                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     256                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    258257               END DO 
    259258            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r5883 r6004  
    136136      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition 
    137137      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901) 
    138 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp ) 
     138901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp ) 
    139139      ! 
    140140      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition 
    141141      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 ) 
    142 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp ) 
     142902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp ) 
    143143      IF(lwm) WRITE ( numond, nambbc ) 
    144144      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r5883 r6004  
    210210                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
    211211                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
    212                   &             / ( e1e2t(ji,jj) * e3t_n(ji,jj,ik) ) 
     212                  &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 
    213213            END DO 
    214214         END DO 
     
    506506      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 
    507507      READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901) 
    508 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp ) 
    509  
     508901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp ) 
     509      ! 
    510510      REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme 
    511511      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 
    512 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp ) 
     512902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp ) 
    513513      IF(lwm) WRITE ( numond, nambbl ) 
    514514      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5883 r6004  
    146146               DO ji = fs_2, fs_jpim1   ! vector opt. 
    147147                  ! 
    148                   zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     148                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
    149149                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  ) 
    150                   zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
     150                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
    151151                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
    152152                     ! 
     
    290290                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
    291291                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
    292                      &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  ) 
     292                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    293293               END DO 
    294294            END DO 
     
    310310               DO ji = fs_2, fs_jpim1   ! vector opt. 
    311311                  ! 
    312                   zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     312                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
    313313                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  ) 
    314                   zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
     314                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
    315315                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
    316316                     ! 
     
    335335               DO jj = 1, jpjm1 
    336336                  DO ji = fs_2, fs_jpim1 
    337                      ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   & 
     337                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)   & 
    338338                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    339339                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     
    350350                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    & 
    351351                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
    352                            &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / e3w_n(ji,jj,jk) 
     352                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 
    353353                     END DO 
    354354                  END DO 
     
    358358                  DO jj = 1, jpjm1 
    359359                     DO ji = fs_2, fs_jpim1 
    360                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     360                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)                      & 
    361361                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
    362362                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     
    371371               DO ji = fs_2, fs_jpim1   ! vector opt. 
    372372                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
    373                      &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  ) 
     373                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    374374               END DO 
    375375            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5916 r6004  
    3131   USE zdf_oce         ! ocean vertical mixing 
    3232   USE domvvl          ! variable volume 
    33    USE dynspg_oce      ! surface     pressure gradient variables 
    34    USE dynhpg          ! hydrostatic pressure gradient  
    3533   USE trd_oce         ! trends: ocean variables 
    3634   USE trdtra          ! trends manager: tracers  
     
    5048   USE agrif_opa_interp 
    5149#endif 
    52 #  include "vectopt_loop_substitute.h90" 
    5350 
    5451   IMPLICIT NONE 
     
    5956   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt 
    6057 
    61    REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg 
    62  
     58   !! * Substitutions 
     59#  include "vectopt_loop_substitute.h90" 
    6360   !!---------------------------------------------------------------------- 
    6461   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)  
     
    8885      !!             domains (lk_agrif=T) 
    8986      !! 
    90       !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
    91       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
     87      !! ** Action  : - tsb & tsn ready for the next time step 
    9288      !!---------------------------------------------------------------------- 
    9389      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     
    104100         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap' 
    105101         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    106          ! 
    107          rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
    108102      ENDIF 
    109103 
     
    154148            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp )  
    155149            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp ) 
    156             CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp ) 
    157150         END DO 
    158151      ENDIF      
    159152      ! 
    160       ! trends computation 
    161153      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    162154         DO jk = 1, jpkm1 
     
    187179      !!  
    188180      !! ** Method  : - Apply a Asselin time filter on now fields. 
    189       !!              - save in (ta,sa) an average over the three time levels  
    190       !!             which will be used to compute rdn and thus the semi-implicit 
    191       !!             hydrostatic pressure gradient (ln_dynhpg_imp = T) 
    192181      !!              - swap tracer fields to prepare the next time_step. 
    193       !!                This can be summurized for tempearture as: 
    194       !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T 
    195       !!             ztm = 0                                   otherwise 
    196       !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp) 
    197       !!             tb  = tn + atfp*[ tb - 2 tn + ta ] 
    198       !!             tn  = ta   
    199       !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call) 
    200       !! 
    201       !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
    202       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    203       !!---------------------------------------------------------------------- 
    204       INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
    205       INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index 
    206       CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
    207       INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
    208       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields 
    209       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields 
    210       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend 
     182      !! 
     183      !! ** Action  : - tsb & tsn ready for the next time step 
     184      !!---------------------------------------------------------------------- 
     185      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index 
     186      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index 
     187      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator) 
     188      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers 
     189      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields 
     190      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields 
     191      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend 
    211192      ! 
    212193      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    213       LOGICAL  ::   ll_tra_hpg       ! local logical 
    214194      REAL(wp) ::   ztn, ztd         ! local scalars 
    215195      !!---------------------------------------------------------------------- 
     
    221201      ENDIF 
    222202      ! 
    223       IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg     
    224       ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    225       ENDIF 
    226       ! 
    227203      DO jn = 1, kjpt 
    228204         ! 
     
    231207               DO ji = fs_2, fs_jpim1 
    232208                  ztn = ptn(ji,jj,jk,jn)                                     
    233                   ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      ! time laplacian on tracers 
    234                   ! 
    235                   ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn  
    236                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta 
    237                   ! 
    238                   IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average 
     209                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers 
     210                  ! 
     211                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn  
     212                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta 
    239213               END DO 
    240214           END DO 
     
    254228      !!  
    255229      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
    256       !!              - save in (ta,sa) a thickness weighted average over the three  
    257       !!             time levels which will be used to compute rdn and thus the semi- 
    258       !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 
    259230      !!              - swap tracer fields to prepare the next time_step. 
    260       !!                This can be summurized for tempearture as: 
    261       !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
    262       !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )    
    263       !!             ztm = 0                                                       otherwise 
    264231      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
    265232      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
    266233      !!             tn  = ta  
    267       !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
    268       !! 
    269       !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
    270       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    271       !!---------------------------------------------------------------------- 
    272       INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
    273       INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index 
    274       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step 
    275       CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
    276       INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
    277       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
    278       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
    279       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
    280       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content 
    281       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content 
    282       !   
    283       LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical 
     234      !! 
     235      !! ** Action  : - tsb & tsn ready for the next time step 
     236      !!---------------------------------------------------------------------- 
     237      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index 
     238      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index 
     239      REAL(wp), DIMENSION(jpk)             , INTENT(in   ) ::  p2dt      ! time-step 
     240      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator) 
     241      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers 
     242      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields 
     243      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields 
     244      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend 
     245      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content 
     246      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content 
     247      ! 
     248      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical 
    284249      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    285250      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     
    293258      ENDIF 
    294259      ! 
    295       IF( cdtype == 'TRA' )  THEN    
    296          ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg 
    297          ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
    298          ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
     260      IF( cdtype == 'TRA' )  THEN   ! active  tracers case  
     261         ll_traqsr  = ln_traqsr        ! solar penetration 
     262         ll_rnf     = ln_rnf           ! river runoffs 
    299263         IF( nn_isf >= 1 ) THEN  
    300             ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing 
     264            ll_isf = .TRUE.            ! ice shelf melting/freezing 
    301265         ELSE 
    302266            ll_isf = .FALSE. 
    303267         END IF 
    304       ELSE                           
    305          ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    306          ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
    307          ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs 
    308          ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing 
     268      ELSE                          ! passive tracers case 
     269         ll_traqsr  = .FALSE.          ! NO solar penetration 
     270         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?   
     271         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??  
    309272      ENDIF 
    310273      ! 
     
    312275         DO jk = 1, jpkm1 
    313276            zfact1 = atfp * p2dt(jk) 
    314             zfact2 = zfact1 / rau0 
     277            zfact2 = zfact1 * r1_rau0 
    315278            DO jj = 2, jpjm1 
    316279               DO ji = fs_2, fs_jpim1 
     
    335298                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
    336299                  ENDIF 
    337  
     300                  ! 
    338301                  ! solar penetration (temperature only) 
    339302                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            &  
    340303                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )  
    341  
     304                     ! 
    342305                  ! river runoff 
    343306                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          & 
    344307                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
    345308                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj) 
    346  
     309                     ! 
    347310                  ! ice shelf 
    348311                  IF( ll_isf ) THEN 
     
    356319                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 
    357320                  END IF 
    358  
     321                  ! 
    359322                  ze3t_f = 1.e0 / ze3t_f 
    360323                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
    361324                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta 
    362325                  ! 
    363                   IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only) 
    364                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
    365                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
    366                   ENDIF 
    367326               END DO 
    368327            END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r5916 r6004  
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
    1212   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
    13    !!            3.7  !  2015-11  (G. Madec)  remove optimisation for fix volume  
     13   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume  
    1414   !!---------------------------------------------------------------------- 
    1515 
     
    105105      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    106106      INTEGER  ::   irgb                     ! local integers 
    107       REAL(wp) ::   zchl, zcoef, z1_2       ! local scalars 
     107      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars 
    108108      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         - 
    109109      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r5883 r6004  
    1818   USE zdf_oce        ! ocean vertical physics variables 
    1919   USE sbc_oce        ! surface boundary condition: ocean 
    20    USE dynspg_oce 
    2120   USE ldftra         ! lateral diffusion: eddy diffusivity 
    2221   USE ldfslp         ! lateral diffusion: iso-neutral slope  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r5883 r6004  
    2929   USE zdfddm         ! ocean vertical physics: double diffusion 
    3030   USE trc_oce        ! share passive tracers/Ocean variables 
     31   ! 
    3132   USE in_out_manager ! I/O manager 
    3233   USE lib_mpp        ! MPP library 
     
    4950CONTAINS 
    5051 
    51    SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kstp,   & 
     52   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts,   & 
    5253      &                                        ptb , pta , kjpt ) 
    5354      !!---------------------------------------------------------------------- 
     
    7576      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    7677      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
    77       INTEGER                              , INTENT(in   ) ::   kstp     ! number of sub-time step 
     78      INTEGER                              , INTENT(in   ) ::   ksts     ! number of sub-time step 
    7879      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step 
    7980      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
     
    8182      ! 
    8283      INTEGER  ::  ji, jj, jk, jn, jl   ! dummy loop indices 
    83       REAL(wp) ::  z1_kstp, ze3tr       ! local scalars 
     84      REAL(wp) ::  z1_ksts, ze3tr       ! local scalars 
    8485      REAL(wp) ::  ztra, ze3tb, z2dt    !   -      - 
    8586      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztb, zwf 
     
    9899      ! Initializations 
    99100      ! --------------- 
    100       z1_kstp = 1._wp / REAL( kstp, wp ) 
     101      z1_ksts = 1._wp / REAL( ksts, wp ) 
    101102      zwf(:,:, 1 ) = 0._wp    ! no flux at the surface and at bottom level 
    102103      zwf(:,:,jpk) = 0._wp 
     
    107108         ztb(:,:,:) = ptb(:,:,:,jn)    ! initial before value for tracer 
    108109         !  
    109          DO jl = 1, kstp         !==  Split-explicit loop  ==! 
     110         DO jl = 1, ksts         !==  Split-explicit loop  ==! 
    110111            !               
    111112            DO jk = 2, jpk             ! 1st vertical derivative (w-flux) 
     
    122123            ! 
    123124            DO jk = 1, jpkm1           ! 2nd vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp 
    124                z2dt = z1_kstp * p2dt(jk)  
     125               z2dt = z1_ksts * p2dt(jk)  
    125126               DO jj = 2, jpjm1  
    126127                  DO ji = fs_2, fs_jpim1   ! vector opt. 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r5883 r6004  
    1616   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
    1717   !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition 
     18   !!            3.7  !  2015-11  (G. Madec, A. Coward)  non linear free surface by default  
    1819   !!---------------------------------------------------------------------- 
    1920   
     
    134135               DO jj = 2, jpjm1 
    135136                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     137!!gm BUG  I think, use e3w_a instead of e3w_n 
    136138                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  ) 
    137139                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r5845 r6004  
    110110               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    111111               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     112!!gm BUG ? when applied to before fields, e3w_b should be used.... 
    112113               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
    113114               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90

    r5215 r6004  
    7171   INTEGER, PUBLIC, PARAMETER ::   jpdyn_bfri = 12     !: implicit bottom friction (ln_bfrimp=.TRUE.) 
    7272   INTEGER, PUBLIC, PARAMETER ::   jpdyn_ken  = 13     !: use for calculation of KE 
    73    INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgflt  = 14  !: filter contribution to surface pressure gradient (spg_flt) 
    74    INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgexp  = 15  !: explicit contribution to surface pressure gradient (spg_flt) 
    7573   ! 
    7674   !!---------------------------------------------------------------------- 
    77    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     75   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    7876   !! $Id$ 
    7977   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90

    r5845 r6004  
    112112      CASE( jpdyn_spg )   ;   CALL iom_put( "utrd_spg", putrd )    ! surface pressure gradient 
    113113                              CALL iom_put( "vtrd_spg", pvtrd ) 
    114       CASE( jpdyn_spgexp );   CALL iom_put( "utrd_spgexp", putrd ) ! surface pressure gradient (explicit) 
    115                               CALL iom_put( "vtrd_spgexp", pvtrd ) 
    116       CASE( jpdyn_spgflt );   CALL iom_put( "utrd_spgflt", putrd ) ! surface pressure gradient (filtered) 
    117                               CALL iom_put( "vtrd_spgflt", pvtrd ) 
    118114      CASE( jpdyn_pvo )   ;   CALL iom_put( "utrd_pvo", putrd )    ! planetary vorticity 
    119115                              CALL iom_put( "vtrd_pvo", pvtrd ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5866 r6004  
    9393      CALL lbc_lnk( putrd, 'U', -1. )   ;   CALL lbc_lnk( pvtrd, 'V', -1. )      ! lateral boundary conditions 
    9494      ! 
    95       IF( .NOT.ln_linssh .AND. kt /= nkstp ) THEN   ! Variable volume: set box volume at the 1st call of kt time step 
    96          nkstp = kt 
    97          DO jk = 1, jpkm1 
    98             bu   (:,:,jk) =           e1e2u(:,:) * e3u_n(:,:,jk) 
    99             bv   (:,:,jk) =           e1e2v(:,:) * e3v_n(:,:,jk) 
    100             r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) * tmask(:,:,jk) 
    101          END DO 
    102       ENDIF 
     95      nkstp = kt 
     96      DO jk = 1, jpkm1 
     97         bu   (:,:,jk) =    e1e2u(:,:) * e3u_n(:,:,jk) 
     98         bv   (:,:,jk) =    e1e2v(:,:) * e3v_n(:,:,jk) 
     99         r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk) 
     100      END DO 
    103101      ! 
    104102      zke(:,:,jpk) = 0._wp 
     
    117115      ! 
    118116      SELECT CASE( ktrd ) 
    119          CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
    120          CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
    121          CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 
    122          CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 
    123          CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
    124          CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
    125          CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
    126          CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
    127          CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
    128          CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
    129                                  !                                   ! wind stress trends 
     117         CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg"   , zke )    ! hydrostatic pressure gradient 
     118         CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg"   , zke )    ! surface pressure gradient 
     119         CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo"   , zke )    ! planetary vorticity 
     120         CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo"   , zke )    ! relative  vorticity     (or metric term) 
     121         CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg"   , zke )    ! Kinetic Energy gradient (or had) 
     122         CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad"   , zke )    ! vertical   advection 
     123         CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf"   , zke )    ! lateral diffusion 
     124         CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf"   , zke )    ! vertical diffusion  
     125         !                   !                                          ! wind stress trends 
    130126                                 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
    131                            z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
    132                            z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
     127                           z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 
     128                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 
    133129                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    134130                           DO jj = 2, jpj 
    135131                              DO ji = 2, jpi 
    136                                  zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    137                                  &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
     132                                 zke2d(ji,jj) = r1_rau0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
     133                                 &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    138134                              END DO 
    139135                           END DO 
    140                                  CALL iom_put( "ketrd_tau", zke2d ) 
     136                                 CALL iom_put( "ketrd_tau"   , zke2d )  !  
    141137                                 CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
    142          CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
     138         CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr"   , zke )    ! bottom friction (explicit case)  
    143139!!gm TO BE DONE properly 
    144140!!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 
     
    159155!               END DO 
    160156!            END DO 
    161 !                              CALL iom_put( "ketrd_bfr", zke2d )    ! bottom friction (explicit case) 
     157!                                    CALL iom_put( "ketrd_bfr"  , zke2d )   ! bottom friction (explicit case) 
    162158!         ENDIF 
    163159!!gm end 
    164          CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
     160         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf"   , zke )    ! asselin filter trends  
    165161!! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 
    166162!! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 
     
    184180!                              CALL iom_put( "ketrd_bfri", zke2d ) 
    185181!         ENDIF 
    186          CASE( jpdyn_ken )   ;   ! kinetic energy 
    187                            ! called in dynnxt.F90 before asselin time filter 
    188                            ! with putrd=ua and pvtrd=va 
    189                            zke(:,:,:) = 0.5_wp * zke(:,:,:) 
    190                            CALL iom_put( "KE", zke ) 
    191                            ! 
    192                            CALL ken_p2k( kt , zke ) 
    193                            CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
     182         CASE( jpdyn_ken )   ;                                          ! kinetic energy 
     183                                 ! called in dynnxt.F90 before asselin time filter with putrd=ua and pvtrd=va 
     184                                 zke(:,:,:) = 0.5_wp * zke(:,:,:) 
     185                                 CALL iom_put( "KE", zke ) 
     186                                 ! 
     187                                 CALL ken_p2k( kt , zke ) 
     188                                 CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
    194189         ! 
    195190      END SELECT 
     
    265260      IF( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 
    266261      ! 
    267 !!gm      IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) )   & 
    268 !!gm         &   CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate') 
    269       ! 
    270       IF( ln_linssh ) THEN      ! constant volume: bu, bv, 1/bt computed one for all 
    271          DO jk = 1, jpkm1 
    272             bu   (:,:,jk) =           e1e2u(:,:) * e3u_n(:,:,jk) 
    273             bv   (:,:,jk) =           e1e2v(:,:) * e3v_n(:,:,jk) 
    274             r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) 
    275          END DO 
    276       ENDIF 
    277       ! 
    278262   END SUBROUTINE trd_ken_init 
    279263 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r5866 r6004  
    7878      zpe(:,:,:) = 0._wp 
    7979      ! 
    80       IF ( kt /= nkstp ) THEN   ! full eos: set partial derivatives at the 1st call of kt time step 
     80      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step 
    8181         nkstp = kt 
    8282         CALL eos_pen( tsn, rab_PE, zpe ) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r5866 r6004  
    206206               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
    207207                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   & 
    208                  &              / ( e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) 
     208                 &              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    209209            END DO 
    210210         END DO 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r5866 r6004  
    127127                     ikbt = mikt(ji,jj) 
    128128! JC: possible WAD implementation should modify line below if layers vanish 
    129                      ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
     129                     ztmp = (1.-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    130130                     ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 
    131131                     ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max) 
     
    133133               END DO 
    134134            END IF 
    135          !    
     135            !    
    136136         ELSE 
    137137            zbfrt(:,:) = bfrcoef2d(:,:) 
     
    157157               ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 
    158158               IF ( ln_isfcav ) THEN 
    159                   IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN 
     159                  IF ( miku(ji,jj) + 1  >= mbku(ji,jj) ) THEN 
    160160                     bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) )   & 
    161161                                  &            + ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) ) & 
    162162                                  &          * zecu * (1._wp - umask(ji,jj,1)) 
    163                   END IF 
    164                   IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN 
     163                  ENDIF 
     164                  IF( mikv(ji,jj) + 1  >= mbkv(ji,jj) ) THEN 
    165165                     bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) )   & 
    166166                                  &            + ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) ) & 
    167167                                  &          * zecv * (1._wp - vmask(ji,jj,1)) 
    168                   END IF 
    169                END IF 
     168                  ENDIF 
     169               ENDIF 
    170170            END DO 
    171171         END DO 
    172172         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
    173173 
    174          IF ( ln_isfcav ) THEN 
     174         IF( ln_isfcav ) THEN 
    175175            DO jj = 2, jpjm1 
    176176               DO ji = 2, jpim1 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5836 r6004  
    3636 
    3737   !!---------------------------------------------------------------------- 
    38    !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
    39    !!   nemo_init      : initialization of the NEMO system 
    40    !!   nemo_ctl       : initialisation of the contol print 
    41    !!   nemo_closefile : close remaining open files 
    42    !!   nemo_alloc     : dynamical allocation 
    43    !!   nemo_partition : calculate MPP domain decomposition 
    44    !!   factorise      : calculate the factors of the no. of MPI processes 
     38   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
     39   !!   nemo_init     : initialization of the NEMO system 
     40   !!   nemo_ctl      : initialisation of the contol print 
     41   !!   nemo_closefile: close remaining open files 
     42   !!   nemo_alloc    : dynamical allocation 
     43   !!   nemo_partition: calculate MPP domain decomposition 
     44   !!   factorise     : calculate the factors of the no. of MPI processes 
    4545   !!---------------------------------------------------------------------- 
    46    USE step_oce        ! module used in the ocean time stepping module (step.F90) 
    47    USE domcfg          ! domain configuration               (dom_cfg routine) 
    48    USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    49    USE domain          ! domain initialization             (dom_init routine) 
     46   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     47   USE domcfg         ! domain configuration               (dom_cfg routine) 
     48   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     49   USE domain         ! domain initialization             (dom_init routine) 
    5050#if defined key_nemocice_decomp 
    5151   USE ice_domain_size, only: nx_global, ny_global 
    5252#endif 
    53    USE tideini         ! tidal components initialization   (tide_ini routine) 
    54    USE bdyini          ! open boundary cond. setting       (bdy_init routine) 
    55    USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine) 
    56    USE bdytides        ! open boundary cond. setting   (bdytide_init routine) 
    57    USE istate          ! initial state setting          (istate_init routine) 
    58    USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    59    USE ldftra          ! lateral diffusivity setting    (ldftra_init routine) 
    60    USE zdfini          ! vertical physics setting          (zdf_init routine) 
    61    USE phycst          ! physical constant                  (par_cst routine) 
    62    USE trdini          ! dyn/tra trends initialization     (trd_init routine) 
    63    USE asminc          ! assimilation increments      
    64    USE asmbkg          ! writing out state trajectory 
    65    USE diaptr          ! poleward transports           (dia_ptr_init routine) 
    66    USE diadct          ! sections transports           (dia_dct_init routine) 
    67    USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
    68    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    69    USE step            ! NEMO time-stepping                 (stp     routine) 
    70    USE icbini          ! handle bergs, initialisation 
    71    USE icbstp          ! handle bergs, calving, themodynamics and transport 
    72    USE cpl_oasis3      ! OASIS3 coupling 
    73    USE c1d             ! 1D configuration 
    74    USE step_c1d        ! Time stepping loop for the 1D configuration 
    75    USE dyndmp          ! Momentum damping 
     53   USE tideini        ! tidal components initialization   (tide_ini routine) 
     54   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
     55   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine) 
     56   USE bdytides       ! open boundary cond. setting   (bdytide_init routine) 
     57   USE sbctide, ONLY  : lk_tide 
     58   USE istate         ! initial state setting          (istate_init routine) 
     59   USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
     60   USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
     61   USE zdfini         ! vertical physics setting          (zdf_init routine) 
     62   USE phycst         ! physical constant                  (par_cst routine) 
     63   USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
     64   USE asminc         ! assimilation increments      
     65   USE asmbkg         ! writing out state trajectory 
     66   USE diaptr         ! poleward transports           (dia_ptr_init routine) 
     67   USE diadct         ! sections transports           (dia_dct_init routine) 
     68   USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
     69   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     70   USE step           ! NEMO time-stepping                 (stp     routine) 
     71   USE icbini         ! handle bergs, initialisation 
     72   USE icbstp         ! handle bergs, calving, themodynamics and transport 
     73   USE cpl_oasis3     ! OASIS3 coupling 
     74   USE c1d            ! 1D configuration 
     75   USE step_c1d       ! Time stepping loop for the 1D configuration 
     76   USE dyndmp         ! Momentum damping 
     77   USE stopar         ! Stochastic param.: ??? 
     78   USE stopts         ! Stochastic param.: ??? 
    7679#if defined key_top 
    77    USE trcini          ! passive tracer initialisation 
    78 #endif 
    79    USE lib_mpp         ! distributed memory computing 
     80   USE trcini         ! passive tracer initialisation 
     81#endif 
     82   USE lib_mpp        ! distributed memory computing 
    8083#if defined key_iomput 
    81    USE xios            ! xIOserver 
    82 #endif 
    83    USE sbctide, ONLY   : lk_tide 
    84    USE crsini          ! initialise grid coarsening utility 
    85    USE lbcnfd , ONLY   : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
    86    USE sbc_oce, ONLY   : lk_oasis 
    87    USE stopar 
    88    USE stopts 
     84   USE xios           ! xIOserver 
     85#endif 
     86   USE crsini         ! initialise grid coarsening utility 
     87   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     88   USE sbc_oce, ONLY  : lk_oasis 
    8989 
    9090   IMPLICIT NONE 
     
    402402      !                                      ! external forcing  
    403403!!gm to be added : creation and call of sbc_apr_init 
    404       IF( lk_tide       )   CALL    tide_init( nit000 )    ! tidal harmonics 
     404      IF( lk_tide       )   CALL    tide_init   ! tidal harmonics 
    405405                            CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
    406406!!gm ==>> bdy_init should call bdy_dta_init and bdytide_init  NOT in nemogcm !!! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r5836 r6004  
    2121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s] 
    2222   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s] 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting) [m/s2] 
    2423   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s] 
    2524   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1] 
     
    8584      ! 
    8685      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     & 
    87          &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &       
    88          &      ua_sv(jpi,jpj,jpk)      , va_sv(jpi,jpj,jpk)      ,                             &       
     86         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &           
    8987         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    9088         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5883 r6004  
    22   !!====================================================================== 
    33   !!                       ***  MODULE step  *** 
    4    !! Time-stepping    : manager of the ocean, tracer and ice time stepping 
     4   !! Time-stepping   : manager of the ocean, tracer and ice time stepping 
    55   !!====================================================================== 
    66   !! History :  OPA  !  1991-03  (G. Madec)  Original code 
     
    2828   !!            3.7  !  2014-10  (G. Madec)  LDF simplication  
    2929   !!             -   !  2014-12  (G. Madec) remove KPP scheme 
     30   !!             -   !  2015-11  (J. Chanut) free surface simplification 
    3031   !!---------------------------------------------------------------------- 
    3132 
     
    3435   !!---------------------------------------------------------------------- 
    3536   USE step_oce         ! time stepping definition modules 
    36    USE iom 
     37   ! 
     38   USE iom              ! xIOs server 
    3739 
    3840   IMPLICIT NONE 
     
    176178 
    177179      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    178       !  Ocean dynamics : hdiv, ssh, e3, wn 
    179       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    180                              CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor) 
    181                              CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors  
    182                              CALL wzv           ( kstp )  ! now cross-level velocity  
    183  
    184       IF( lk_dynspg_ts ) THEN  
    185           ! In case the time splitting case, update almost all momentum trends here: 
    186           ! Note that the computation of vertical velocity above, hence "after" sea level 
    187           ! is necessary to compute momentum advection for the rhs of barotropic loop: 
     180      !  Ocean dynamics : hdiv, ssh, e3, u, v, w 
     181      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     182 
     183                            CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor) 
     184      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors  
     185                            CALL wzv           ( kstp )  ! now cross-level velocity  
     186 
    188187!!gm : why also here ???? 
    189             IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
     188      IF( ln_sto_eos    )  CALL sto_pts( tsn )                             ! Random T/S fluctuations 
    190189!!gm 
    191190                            CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation 
    192191                             
     192!!jc: fs simplification 
     193!!jc: lines below are useless if ln_linssh=F. Keep them here (which maintains a bug if ln_linssh=T and ln_zps=T, cf ticket #1636)  
     194!!                                         but ensures reproductible results 
     195!!                                         with previous versions using split-explicit free surface           
    193196            IF( ln_zps .AND. .NOT. ln_isfcav)   &                           ! Partial steps: bottom before horizontal gradient 
    194197               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &  ! of t, s, rd at the last ocean level 
     
    198201               &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    199202               &                                               grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) 
    200  
    201                                   ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
    202                                   va(:,:,:) = 0._wp 
    203           IF(  lk_asminc .AND. ln_asmiau .AND. & 
    204              & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment 
    205           IF( lk_bdy           )  CALL bdy_dyn3d_dmp( kstp )   ! bdy damping trends 
    206                                   CALL dyn_adv      ( kstp )   ! advection (vector or flux form) 
    207                                   CALL dyn_vor      ( kstp )   ! vorticity term including Coriolis 
    208                                   CALL dyn_ldf      ( kstp )   ! lateral mixing 
    209 #if defined key_agrif 
    210           IF(.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn        ! momentum sponge 
    211 #endif 
    212                                   CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure 
    213                                   CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
    214  
    215                                   ua_sv(:,:,:) = ua(:,:,:)     ! Save trends (barotropic trend has been fully updated at this stage) 
    216                                   va_sv(:,:,:) = va(:,:,:) 
    217  
    218                                   CALL div_hor( kstp )         ! Horizontal divergence  (2nd call in time-split case) 
    219                                   CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component) 
    220                                   CALL wzv           ( kstp )  ! now cross-level velocity  
    221       ENDIF 
    222  
    223       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    224       ! diagnostics and outputs             (ua, va, tsa used as workspace) 
    225       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    226       IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    227       IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    228       IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    229       IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    230       IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 
    231       IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
    232                          CALL dia_wri( kstp )         ! ocean model: outputs 
    233       ! 
    234       IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
     203!!jc: fs simplification 
     204                             
     205                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
     206                         va(:,:,:) = 0._wp 
     207 
     208      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
     209                         CALL dyn_asm_inc   ( kstp )  ! apply dynamics assimilation increment 
     210      IF( lk_bdy     )   CALL bdy_dyn3d_dmp ( kstp )  ! bdy damping trends 
     211#if defined key_agrif 
     212      IF(.NOT. Agrif_Root())  &  
     213               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
     214#endif 
     215                         CALL dyn_adv       ( kstp )  ! advection (vector or flux form) 
     216                         CALL dyn_vor       ( kstp )  ! vorticity term including Coriolis 
     217                         CALL dyn_ldf       ( kstp )  ! lateral mixing 
     218                         CALL dyn_hpg       ( kstp )  ! horizontal gradient of Hydrostatic pressure 
     219                         CALL dyn_spg       ( kstp )  ! surface pressure gradient 
     220 
     221                                                      ! With split-explicit free surface, since now transports have been updated and ssha as well 
     222      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated 
     223                            CALL div_hor    ( kstp )              ! Horizontal divergence  (2nd call in time-split case) 
     224         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component) 
     225                            CALL wzv        ( kstp )              ! now cross-level velocity  
     226      ENDIF 
     227 
     228                         CALL dyn_bfr       ( kstp )  ! bottom friction 
     229                         CALL dyn_zdf       ( kstp )  ! vertical diffusion 
     230 
     231      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     232      ! diagnostics and outputs              
     233      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     234      IF( lk_floats  )   CALL flo_stp       ( kstp )  ! drifting Floats 
     235      IF( lk_diahth  )   CALL dia_hth       ( kstp )  ! Thermocline depth (20 degres isotherm depth) 
     236      IF(.NOT.ln_cpl )   CALL dia_fwb       ( kstp )  ! Fresh water budget diagnostics 
     237      IF( lk_diadct  )   CALL dia_dct       ( kstp )  ! Transports 
     238      IF( lk_diaar5  )   CALL dia_ar5       ( kstp )  ! ar5 diag 
     239      IF( lk_diaharm )   CALL dia_harm      ( kstp )  ! Tidal harmonic analysis 
     240                         CALL dia_wri       ( kstp )  ! ocean model: outputs 
     241      ! 
     242      IF( ln_crs     )   CALL crs_fld       ( kstp )  ! ocean model: online field coarsening & output 
    235243 
    236244#if defined key_top 
     
    238246      ! Passive Tracer Model 
    239247      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    240                          CALL trc_stp( kstp )         ! time-stepping 
    241 #endif 
    242  
    243       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    244       ! Active tracers                              (ua, va used as workspace) 
    245       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    246                              tsa(:,:,:,:) = 0._wp           ! set tracer trends to zero 
     248                         CALL trc_stp       ( kstp )  ! time-stepping 
     249#endif 
     250 
     251      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     252      ! Active tracers                               
     253      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     254                         tsa(:,:,:,:) = 0._wp         ! set tracer trends to zero 
    247255 
    248256      IF(  lk_asminc .AND. ln_asmiau .AND. & 
    249          & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
    250                              CALL tra_sbc    ( kstp )       ! surface boundary condition 
    251       IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
    252       IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    253       IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    254       IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
    255       IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends 
    256                              CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    257                              CALL tra_ldf    ( kstp )       ! lateral mixing 
     257         & ln_trainc )   CALL tra_asm_inc   ( kstp )  ! apply tracer assimilation increment 
     258                         CALL tra_sbc       ( kstp )  ! surface boundary condition 
     259      IF( ln_traqsr  )   CALL tra_qsr       ( kstp )  ! penetrative solar radiation qsr 
     260      IF( ln_trabbc  )   CALL tra_bbc       ( kstp )  ! bottom heat flux 
     261      IF( lk_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme 
     262      IF( ln_tradmp  )   CALL tra_dmp       ( kstp )  ! internal damping trends 
     263      IF( lk_bdy     )   CALL bdy_tra_dmp   ( kstp )  ! bdy damping trends 
     264#if defined key_agrif 
     265      IF(.NOT. Agrif_Root())  &  
     266               &         CALL Agrif_Sponge_tra        ! tracers sponge 
     267#endif 
     268                         CALL tra_adv       ( kstp )  ! horizontal & vertical advection 
     269                         CALL tra_ldf       ( kstp )  ! lateral mixing 
    258270 
    259271!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    260       IF( ln_diaptr      )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics 
     272      IF( ln_diaptr  )   CALL dia_ptr                 ! Poleward adv/ldf TRansports diagnostics 
    261273!!gm 
    262  
    263 #if defined key_agrif 
    264       IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    265 #endif 
    266                              CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
    267  
    268       IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos) 
    269          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    270                              CALL tra_nxt( kstp )                ! tracer fields at next time step 
    271 !!gm : why again a call to sto_pts ??? 
    272             IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations 
    273 !!gm 
    274                              CALL eos    ( tsa, rhd, rhop, gdept_n(:,:,:) )   ! Time-filtered in situ density for hpg computation 
    275             IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
    276                &             CALL zps_hde    ( kstp, jpts, tsa, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    277                &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    278             IF( ln_zps .AND.       ln_isfcav)                                & 
    279                &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, gtui, gtvi,  &    ! Partial steps for top/bottom cells 
    280                &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    281                &                                                grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) 
    282       ELSE                                                  ! centered hpg  (eos then time stepping) 
    283          IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case 
    284 !!gm : why again a call to sto_pts ??? 
    285             IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations 
    286 !!gm 
    287                              CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation 
    288          IF( ln_zps .AND. .NOT. ln_isfcav)                                   & 
    289                &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: bottom before horizontal gradient 
    290                &                                           rhd, gru , grv    )    ! of t, s, rd at the last ocean level 
    291          IF( ln_zps .AND.       ln_isfcav)                                   &  
    292                &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,   &    ! Partial steps for top/bottom cells 
    293                &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
    294                &                                    grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
    295          ENDIF 
    296          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    297                              CALL tra_nxt( kstp )                ! tracer fields at next time step 
    298       ENDIF 
    299  
    300       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    301       ! Dynamics                                    (tsa used as workspace) 
    302       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    303       IF( lk_dynspg_ts   )  THEN 
    304                                                              ! revert to previously computed momentum tendencies 
    305                                                              ! (not using ua, va as temporary arrays during tracers' update could avoid that) 
    306                                ua(:,:,:) = ua_sv(:,:,:) 
    307                                va(:,:,:) = va_sv(:,:,:) 
    308  
    309                                CALL dyn_bfr( kstp )         ! bottom friction 
    310                                CALL dyn_zdf( kstp )         ! vertical diffusion 
    311       ELSE 
    312                                ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
    313                                va(:,:,:) = 0._wp 
    314  
    315         IF(  lk_asminc .AND. ln_asmiau .AND. & 
    316            & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
    317         IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
    318         IF( lk_bdy          )  CALL bdy_dyn3d_dmp(kstp )    ! bdy damping trends 
    319                                CALL dyn_adv( kstp )         ! advection (vector or flux form) 
    320                                CALL dyn_vor( kstp )         ! vorticity term including Coriolis 
    321                                CALL dyn_ldf( kstp )         ! lateral mixing 
    322 #if defined key_agrif 
    323         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn        ! momemtum sponge 
    324 #endif 
    325                                CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure 
    326                                CALL dyn_bfr( kstp )         ! bottom friction 
    327                                CALL dyn_zdf( kstp )         ! vertical diffusion 
    328                                CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
    329       ENDIF 
    330                                CALL dyn_nxt( kstp )         ! lateral velocity at next time step 
    331  
    332                                CALL ssh_swp( kstp )         ! swap of sea surface height 
    333                                CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors 
     274                         CALL tra_zdf       ( kstp )  ! vertical mixing and after tracer fields 
     275      IF( ln_zdfnpc  )   CALL tra_npc       ( kstp )  ! update after fields by non-penetrative convection 
     276 
     277      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     278      ! Set boundary conditions and Swap 
     279      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     280!!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap  
     281!!    (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields.  
     282!!    If so:  
     283!!    (i) no need to call agrif update at initialization time 
     284!!    (ii) no need to update "before" fields  
     285!! 
     286!!    Apart from creating new tra_swp/dyn_swp routines, this however:  
     287!!    (i) makes boundary conditions at initialization time computed from updated fields which is not the case between  
     288!!    two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation",  
     289!!    e.g. a shift of the feedback interface inside child domain.  
     290!!    (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same 
     291!!    place. 
     292!!  
     293!!jc2: dynnxt must be the latest call. fse3t_b are indeed updated in that routine 
     294                         CALL tra_nxt       ( kstp )  ! finalize (bcs) tracer fields at next time step and swap 
     295                         CALL dyn_nxt       ( kstp )  ! finalize (bcs) velocities at next time step and swap 
     296                         CALL ssh_swp       ( kstp )  ! swap of sea surface height 
     297      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors 
    334298      ! 
    335299 
    336300!!gm : This does not only concern the dynamics ==>>> add a new title 
    337301!!gm2: why ouput restart before AGRIF update? 
    338       IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file 
     302!! 
     303!!jc: That would be better, but see comment above 
     304!! 
     305      IF( lrst_oce   )   CALL rst_write     ( kstp )  ! write output ocean restart file 
    339306 
    340307#if defined key_agrif 
     
    342309      ! AGRIF 
    343310      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    344                                CALL Agrif_Integrate_ChildGrids( stp )   
    345  
    346       IF ( Agrif_NbStepint().EQ.0 ) THEN 
    347                                CALL Agrif_Update_Tra()      ! Update active tracers 
    348                                CALL Agrif_Update_Dyn()      ! Update momentum 
    349       ENDIF 
    350 #endif 
    351       IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics 
    352       IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
     311                         CALL Agrif_Integrate_ChildGrids( stp )   
     312 
     313      IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update  
     314!!jc in fact update is useless at last time step, but do it for global diagnostics 
     315                         CALL Agrif_Update_Tra()      ! Update active tracers 
     316                         CALL Agrif_Update_Dyn()      ! Update momentum 
     317      ENDIF 
     318#endif 
     319      IF( ln_diahsb  )   CALL dia_hsb       ( kstp )  ! - ML - global conservation diagnostics 
     320      IF( lk_diaobs  )   CALL dia_obs       ( kstp )  ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    353321 
    354322      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    355323      ! Control 
    356324      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    357                                CALL stp_ctl( kstp, indic ) 
    358       IF( indic < 0        )  THEN 
    359                                CALL ctl_stop( 'step: indic < 0' ) 
    360                                CALL dia_wri_state( 'output.abort', kstp ) 
    361       ENDIF 
    362       IF( kstp == nit000   )  THEN 
     325                         CALL stp_ctl       ( kstp, indic ) 
     326      IF( indic < 0  ) THEN 
     327                         CALL ctl_stop( 'step: indic < 0' ) 
     328                         CALL dia_wri_state( 'output.abort', kstp ) 
     329      ENDIF 
     330      IF( kstp == nit000 ) THEN 
    363331                 CALL iom_close( numror )     ! close input  ocean restart file 
    364332         IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce 
     
    371339      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    372340!!gm why lk_oasis and not lk_cpl ???? 
    373       IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     341      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    374342      ! 
    375343#if defined key_iomput 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5836 r6004  
    4040   USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine) 
    4141   USE dynzdf           ! vertical diffusion               (dyn_zdf routine) 
    42    USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine) 
    4342   USE dynspg           ! surface pressure gradient        (dyn_spg routine) 
    4443 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r3294 r6004  
    1616   USE oce             ! ocean dynamics and tracers variables 
    1717   USE dom_oce         ! ocean space and time domain variables  
    18    USE sol_oce         ! ocean space and time domain variables  
     18   USE c1d             ! 1D vertical configuration 
     19   ! 
    1920   USE in_out_manager  ! I/O manager 
    2021   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2122   USE lib_mpp         ! distributed memory computing 
    22    USE dynspg_oce      ! pressure gradient schemes  
    23    USE c1d             ! 1D vertical configuration 
    2423 
    2524   IMPLICIT NONE 
     
    3231   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3332   !!---------------------------------------------------------------------- 
    34  
    3533CONTAINS 
    3634 
     
    4341      !! ** Method  : - Save the time step in numstp 
    4442      !!              - Print it each 50 time steps 
    45       !!              - Print solver statistics in numsol  
    46       !!              - Stop the run IF problem for the solver ( indec < 0 ) 
     43      !!              - Stop the run IF problem ( indic < 0 ) 
    4744      !! 
    4845      !! ** Actions :   'time.step' file containing the last ocean time-step 
    4946      !!                 
    5047      !!---------------------------------------------------------------------- 
    51       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    52       INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence 
     48      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     49      INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    5350      !! 
    54       INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    55       INTEGER  ::   ii, ij, ik              ! temporary integers 
    56       REAL(wp) ::   zumax, zsmin, zssh2     ! temporary scalars 
    57       INTEGER, DIMENSION(3) ::   ilocu      !  
    58       INTEGER, DIMENSION(2) ::   ilocs      !  
     51      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     52      INTEGER  ::   ii, ij, ik             ! local integers 
     53      REAL(wp) ::   zumax, zsmin, zssh2    ! local scalars 
     54      INTEGER, DIMENSION(3) ::   ilocu     !  
     55      INTEGER, DIMENSION(2) ::   ilocs     !  
    5956      !!---------------------------------------------------------------------- 
    60  
     57      ! 
    6158      IF( kt == nit000 .AND. lwp ) THEN 
    6259         WRITE(numout,*) 
     
    6663         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    6764      ENDIF 
    68  
     65      ! 
    6966      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
    7067      IF(lwp) REWIND( numstp )                       !  -------------------------- 
    71  
     68      ! 
    7269      !                                              !* Test maximum of velocity (zonal only) 
    7370      !                                              !  ------------------------ 
     
    105102      ENDIF 
    1061039400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5) 
    107  
     104      ! 
    108105      !                                              !* Test minimum of salinity 
    109106      !                                              !  ------------------------ 
    110107      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5 
    111       zsmin = 100.e0 
     108      zsmin = 100._wp 
    112109      DO jj = 2, jpjm1 
    113110         DO ji = 1, jpi 
     
    139136      ENDIF 
    1401379500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 
    141  
    142        
     138      ! 
     139      ! 
    143140      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration 
    144141 
    145       ! log file (solver or ssh statistics) 
    146       ! -------- 
    147       IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required) 
    148          ! 
    149          IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver 
    150          ! 
    151          IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found  
    152             IF(lwp) THEN 
    153                WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode' 
    154                WRITE(numout,*) ' ====== ' 
    155                WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps 
    156                WRITE(numout,*) 
    157                WRITE(numout,*) ' stpctl: output of last fields' 
    158                WRITE(numout,*) ' ======  ' 
    159             ENDIF 
    160          ENDIF 
    161          ! 
    162       ELSE                                   !* ssh statistics (and others...) 
    163          IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file) 
    164             CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    165          ENDIF 
    166          ! 
    167          zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) ) 
    168          IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain 
    169          ! 
    170          IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics 
    171          ! 
     142      ! log file (ssh statistics) 
     143      ! --------                                   !* ssh statistics (and others...) 
     144      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file) 
     145         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    172146      ENDIF 
    173  
     147      ! 
     148      zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) ) 
     149      IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain 
     150      ! 
     151      IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics 
     152      ! 
    1741539200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 ) 
    1751549300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r5845 r6004  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration          
    11    !!---------------------------------------------------------------------- 
    12    USE par_oce 
    13    USE in_out_manager  ! I/O manager 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE lib_mpp         ! MPP library 
     10   !!   trc_oce_rgb   : tabulated attenuation coefficients for RGB light penetration          
     11   !!---------------------------------------------------------------------- 
     12   USE par_oce        ! ocean parameters 
     13   USE dom_oce        ! ocean space and time domain 
     14   ! 
     15   USE in_out_manager ! I/O manager 
     16   USE lib_mpp        ! MPP library 
    1617 
    1718   IMPLICIT NONE 
     
    4142   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag 
    4243#endif 
    43  
    4444#if defined key_offline 
    4545   !!---------------------------------------------------------------------- 
     
    6464   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .FALSE.   !: degradation flag 
    6565#endif 
    66  
    6766   !!---------------------------------------------------------------------- 
    6867   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    r5845 r6004  
    2626   USE dom_oce         ! ocean space and time domain 
    2727   USE zdf_oce         ! ocean vertical physics 
    28    USE sol_oce         ! solver variables 
    2928   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3029   USE sbc_ice         ! Surface boundary condition: ice fields 
     
    105104      !! ** Method  :  use iom_put 
    106105      !!---------------------------------------------------------------------- 
    107       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     106      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    108107      !!---------------------------------------------------------------------- 
    109108      !  
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/step.F90

    r5845 r6004  
    1616   USE oce              ! ocean dynamics and tracers variables 
    1717   USE dom_oce          ! ocean space and time domain variables  
    18    USE sbc_oce 
    19    USE sbccpl 
    2018   USE daymod           ! calendar                         (day     routine) 
     19   USE sbc_oce          ! surface boundary condition: fields 
    2120   USE sbcmod           ! surface boundary condition       (sbc     routine) 
    2221   USE sbcrnf           ! surface boundary condition: runoff variables 
     22   USE sbccpl           ! surface boundary condition: coupled interface 
    2323   USE eosbn2           ! equation of state                (eos_bn2 routine) 
    2424   USE diawri           ! Standard run outputs             (dia_wri routine) 
     
    2828#endif 
    2929   USE stpctl           ! time stepping control            (stp_ctl routine) 
    30    USE prtctl           ! Print control                    (prt_ctl routine) 
    3130   ! 
    3231   USE in_out_manager   ! I/O manager 
     32   USE prtctl           ! Print control                    (prt_ctl routine) 
     33   USE iom              ! 
     34   USE lbclnk           ! 
    3335   USE timing           ! Timing             
    34    USE iom              ! 
    35    USE lbclnk 
    3636#if defined key_iomput 
    3737   USE xios 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r5845 r6004  
    7373      !!                CFC concentration in pico-mol/m3 
    7474      !!---------------------------------------------------------------------- 
    75       ! 
    7675      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    7776      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r5845 r6004  
    240240                IF( ln_diatrc .OR. lk_iomput ) THEN 
    241241                  ! convert fluxes in per day 
    242                   ze3t = e3t_n(ji,jj,jk) * 86400. 
     242                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    243243                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    244244                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     
    361361                IF( ln_diatrc .OR. lk_iomput ) THEN 
    362362                  ! convert fluxes in per day 
    363                   ze3t = e3t_n(ji,jj,jk) * 86400. 
     363                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    364364                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    365365                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     
    380380                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    381381                  !    
    382                   zw3d(ji,jj,jk,1) = zno3phy * 86400 
    383                   zw3d(ji,jj,jk,2) = znh4phy * 86400 
    384                   zw3d(ji,jj,jk,3) = znh4no3 * 86400 
     382                  zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 
     383                  zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
     384                  zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    385385                   ! 
    386386                ENDIF 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r5845 r6004  
    4848   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
    50  
    5150CONTAINS 
    5251 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r5845 r6004  
    109109         IF( iom_use( "TDETSED" ) ) THEN 
    110110            CALL wrk_alloc( jpi, jpj, zw2d ) 
    111             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400. 
     111            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
    112112            DO jk = 2, jpkm1 
    113                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 
     113               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
    114114            END DO 
    115115            CALL iom_put( "TDETSED", zw2d ) 
     
    119119         IF( ln_diatrc ) THEN  
    120120            CALL wrk_alloc( jpi, jpj, zw2d ) 
    121             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400. 
     121            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
    122122            DO jk = 2, jpkm1 
    123                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 
     123               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
    124124            END DO 
    125125            trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r5845 r6004  
    3939   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 
    41  
    4241CONTAINS 
    4342 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5845 r6004  
    8383      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8484      ! 
    85       INTEGER  ::   ji, jj, jk, jn, jl   ! dummy loop indices 
    86       CHARACTER (len=22) :: charout 
     85      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
     86      CHARACTER (len=22) ::   charout 
    8787      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
    88       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
     88      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
    8989      !!---------------------------------------------------------------------- 
    9090      ! 
     
    176176      !!              called by trc_dmp at the first timestep (nittrc000) 
    177177      !!---------------------------------------------------------------------- 
    178       ! 
    179       INTEGER ::  ios                 ! Local integer output status for namelist read 
    180       INTEGER :: imask  !local file handle 
    181       ! 
     178      INTEGER ::   ios, imask  ! local integers 
     179      !! 
    182180      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
    183181      !!---------------------------------------------------------------------- 
    184  
     182      ! 
    185183      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    186184      ! 
    187  
    188185      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
    189186      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
     
    229226   END SUBROUTINE trc_dmp_ini 
    230227 
     228 
    231229   SUBROUTINE trc_dmp_clo( kt ) 
    232230      !!--------------------------------------------------------------------- 
     
    241239      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 
    242240      !!---------------------------------------------------------------------- 
    243       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    244       ! 
    245       INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
    246       INTEGER :: isrow                                      ! local index 
    247       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    248  
    249       !!---------------------------------------------------------------------- 
    250  
     241      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     242      ! 
     243      INTEGER ::   ji , jj, jk, jn, jl, jc   ! dummy loop indicesa 
     244      INTEGER ::   isrow                     ! local index 
     245      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
     246      !!---------------------------------------------------------------------- 
     247      ! 
    251248      IF( kt == nit000 ) THEN 
    252249         ! initial values 
     
    360357   END SUBROUTINE trc_dmp_clo 
    361358 
    362  
    363359#else 
    364360   !!---------------------------------------------------------------------- 
     
    372368#endif 
    373369 
    374  
    375370   !!====================================================================== 
    376371END MODULE trcdmp 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5883 r6004  
    2222   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine) 
    2323   USE trd_oce        ! trends: ocean variables 
    24    USE trdtra         ! trends manager: tracers  
     24   USE trdtra         ! trends manager: tracers 
     25   ! 
    2526   USE prtctl_trc     ! Print control 
    2627 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r5845 r6004  
    4747CONTAINS 
    4848 
    49    SUBROUTINE trc_bc_init(ntrc) 
     49   SUBROUTINE trc_bc_init( ntrc ) 
    5050      !!---------------------------------------------------------------------- 
    5151      !!                   ***  ROUTINE trc_bc_init  *** 
     
    5656      !!              - allocates passive tracer BC data structure  
    5757      !!---------------------------------------------------------------------- 
    58       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    59       INTEGER            :: jl, jn                         ! dummy loop indices 
    60       INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    61       INTEGER            ::  ios                           ! Local integer output status for namelist read 
     58      INTEGER,INTENT(IN) ::   ntrc   ! number of tracers 
     59      ! 
     60      INTEGER ::  jl, jn                       ! dummy loop indices 
     61      INTEGER ::  ierr0, ierr1, ierr2, ierr3   ! temporary integers 
     62      INTEGER ::  ios                         ! Local integer output status for namelist read 
    6263      CHARACTER(len=100) :: clndta, clntrc 
    63       ! 
     64      !! 
    6465      CHARACTER(len=100) :: cn_dir 
    6566      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read 
     
    257258      USE fldread 
    258259      ! 
    259       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     260      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    260261      !!--------------------------------------------------------------------- 
    261262      ! 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r5866 r6004  
    240240      ! 
    241241   END SUBROUTINE trc_dta 
     242    
    242243#else 
    243244   !!---------------------------------------------------------------------- 
     
    249250   END SUBROUTINE trc_dta 
    250251#endif 
     252 
    251253   !!====================================================================== 
    252254END MODULE trcdta 
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r5866 r6004  
    596596      WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt 
    597597   END SUBROUTINE trc_sub_ini 
    598  
    599598#endif 
    600599 
Note: See TracChangeset for help on using the changeset viewer.