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

Changeset 3764


Ignore:
Timestamp:
2013-01-23T15:33:04+01:00 (11 years ago)
Author:
smasson
Message:

dev_MERGE_2012: report bugfixes done in the trunk from r3555 to r3763 into dev_MERGE_2012

Location:
branches/2012/dev_MERGE_2012
Files:
1 added
1 deleted
61 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Biblio/Biblio.bib

    r3680 r3764  
    14121412} 
    14131413 
    1414 @ARTICLE{Hunke2008, 
     1414@TECHREPORT{Hunke2008, 
    14151415  author = {E.C. Hunke and W.H. Lipscomb}, 
    14161416  title = {CICE: the Los Alamos sea ice model documentation and software user's manual,  
    14171417        Version 4.0}, 
     1418  institution = { Los Alamos National Laboratory, N.M.}, 
    14181419  publisher = {LA-CC-06-012, Los Alamos National Laboratory, N.M.}, 
    14191420  year = {2008} 

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Chapters/Chap_CFG.tex

    r3294 r3764  
    3131 
    3232% ================================================================ 
    33 % 1D model functionality 
     33% 1D model configuration 
    3434% ================================================================ 
    3535\section{Water column model: 1D model (C1D) (\key{c1d})} 
    … …  
    4848 
    4949The methodology is based on the use of the zoom functionality over the smallest possible  
    50 domain : a 3 x 3 domain centred on the grid point of interest (see \S\ref{MISC_zoom}),  
     50domain : a 3x3 domain centred on the grid point of interest (see \S\ref{MISC_zoom}),  
    5151with some extra routines. There is no need to define a new mesh, bathymetry,  
    5252initial state or forcing, since the 1D model will use those of the configuration it is a zoom of.  
    53 The chosen grid point is set in par\_oce.F90 module by setting the \jp{jpizoom} and \jp{jpjzoom}  
     53The chosen grid point is set in \mdl{par\_oce} module by setting the \jp{jpizoom} and \jp{jpjzoom}  
    5454parameters to the indices of the location of the chosen grid point. 
    5555 
    56 The 1D model has some specifies. First, all the horizontal derivatives are assumed to be zero.  
    57 Therefore a simplified \rou{step} routine is used (\rou{step\_c1d}) in which both lateral tendancy  
    58 terms and lateral physics are not called, and the vertical velocity is zero (so far, no attempt at 
    59 introducing a Ekman pumping velocity has been made). 
    60 Second, the two components of the velocity are moved on a $T$-point.  
    61 This requires a specific treatment of the Coriolis term (see \rou{dyncor\_c1d}) and of the  
    62 dynamic time stepping (\rou{dynnxt\_c1d}). 
    63 All the relevant modules can be found in the NEMOGCM/NEMO/OPA\_SRC/C1D directory of  
     56The 1D model has some specifies. First, all the horizontal derivatives are assumed to be zero, and 
     57second, the two components of the velocity are moved on a $T$-point.  
     58Therefore, defining \key{c1d} changes five main things in the code behaviour:  
     59\begin{description} 
     60\item[(1)] the lateral boundary condition routine (\rou{lbc\_lnk}) set the value of the central column  
     61of the 3x3 domain is imposed over the whole domain ;  
     62\item[(3)] a call to \rou{lbc\_lnk} is systematically done when reading input data ($i.e.$ in \mdl{iom}) ;  
     63\item[(3)] a simplified \rou{stp} routine is used (\rou{stp\_c1d}, see \mdl{step\_c1d} module) in which  
     64both lateral tendancy terms and lateral physics are not called ;  
     65\item[(4)] the vertical velocity is zero (so far, no attempt at introducing a Ekman pumping velocity  
     66has been made) ;  
     67\item[(5)] a simplified treatment of the Coriolis term is performed as $U$- and $V$-points are the same  
     68(see \mdl{dyncor\_c1d}). 
     69\end{description} 
     70All the relevant \textit{\_c1d} modules can be found in the NEMOGCM/NEMO/OPA\_SRC/C1D directory of  
    6471the \NEMO distribution. 
    6572 
    … …  
    206213% ------------------------------------------------------------------------------------------------------------- 
    207214\section{GYRE family: double gyre basin (\key{gyre})} 
    208 \label{MISC_config_gyre} 
     215\label{CFG_gyre} 
    209216 
    210217The GYRE configuration \citep{Levy_al_OM10} have been built to simulated  

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Chapters/Chap_DIA.tex

    r3680 r3764  
    10181018In addition, a series of diagnostics has been added in the \mdl{diaar5}.  
    10191019They corresponds to outputs that are required for AR5 simulations  
    1020 (see Section \ref{MISC_steric} below for one of them).  
     1020(see Section \ref{DIA_steric} below for one of them).  
    10211021Activating those outputs requires to define the \key{diaar5} CPP key. 
    10221022\\ 

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Chapters/Chap_DOM.tex

    r3680 r3764  
    499499Hybridation of the three main coordinates are available: $s-z$ or $s-zps$ coordinate  
    500500(Fig.~\ref{Fig_z_zps_s_sps}d and \ref{Fig_z_zps_s_sps}e). When using the variable  
    501 volume option \key{vvl}) ($i.e.$ non-linear free surface), the coordinate follow the  
     501volume option \key{vvl} ($i.e.$ non-linear free surface), the coordinate follow the  
    502502time-variation of the free surface so that the transformation is time dependent:  
    503503$z(i,j,k,t)$ (Fig.~\ref{Fig_z_zps_s_sps}f). This option can be used with full step  

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Chapters/Chap_DYN.tex

    r3294 r3764  
    127127This is of paramount importance. Replacing $T$ by the number $1$ in the tracer equation and summing 
    128128over the water column must lead to the sea surface height equation otherwise tracer content 
    129 will not be conserved \ref{Griffies_al_MWR01, LeclairMadec2009}. 
     129will not be conserved \citep{Griffies_al_MWR01, Leclair_Madec_OM09}. 
    130130 
    131131The vertical velocity is computed by an upward integration of the horizontal  
    … …  
    189189the relative vorticity term and horizontal kinetic energy for the planetary vorticity  
    190190term (MIX scheme) ; or conserving both the potential enstrophy of horizontally non-divergent  
    191 flow and horizontal kinetic energy (EEN scheme) (see  Appendix~\ref{Apdx_C_vor_zad}). In the  
     191flow and horizontal kinetic energy (EEN scheme) (see  Appendix~\ref{Apdx_C_vorEEN}). In the  
    192192case of ENS, ENE or MIX schemes the land sea mask may be slightly modified to ensure the  
    193193consistency of vorticity term with analytical equations (\textit{ln\_dynvor\_con}=true). 
    … …  
    331331This EEN scheme in fact combines the conservation properties of the ENS and ENE schemes.  
    332332It conserves both total energy and potential enstrophy in the limit of horizontally  
    333 nondivergent flow ($i.e.$ $\chi$=$0$) (see  Appendix~\ref{Apdx_C_vor_zad}).  
     333nondivergent flow ($i.e.$ $\chi$=$0$) (see  Appendix~\ref{Apdx_C_vorEEN}).  
    334334Applied to a realistic ocean configuration, it has been shown that it leads to a significant  
    335335reduction of the noise in the vertical velocity field \citep{Le_Sommer_al_OM09}.  
    … …  
    938938is the \textit{before} velocity in time, except for the pure vertical component  
    939939that appears when a tensor of rotation is used. This latter term is solved  
    940 implicitly together with the vertical diffusion term (see \S\ref{DOM_nxt})  
     940implicitly together with the vertical diffusion term (see \S\ref{STP})  
    941941 
    942942At the lateral boundaries either free slip, no slip or partial slip boundary  
    … …  
    10661066scheme (\np{ln\_zdfexp}=true) using a time splitting technique  
    10671067(\np{nn\_zdfexp} $>$ 1) or $(b)$ a backward (or implicit) time differencing scheme  
    1068 (\np{ln\_zdfexp}=false) (see \S\ref{DOM_nxt}). Note that namelist variables  
     1068(\np{ln\_zdfexp}=false) (see \S\ref{STP}). Note that namelist variables  
    10691069\np{ln\_zdfexp} and \np{nn\_zdfexp} apply to both tracers and dynamics.  
    10701070 

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Chapters/Chap_TRA.tex

    r3308 r3764  
    264264transport) rather than TVD. The TVD scheme is implemented in the \mdl{traadv\_tvd} module. 
    265265 
    266 For stability reasons (see \S\ref{DOM_nxt}), 
     266For stability reasons (see \S\ref{STP}), 
    267267$\tau _u^{cen2}$ is evaluated  in (\ref{Eq_tra_adv_tvd}) using the \textit{now} tracer while $\tau _u^{ups}$  
    268268is evaluated using the \textit{before} tracer. In other words, the advective part of  
    … …  
    337337\np{ln\_traadv\_ubs}=true. 
    338338 
    339 For stability reasons  (see \S\ref{DOM_nxt}), 
     339For stability reasons  (see \S\ref{STP}), 
    340340the first term  in \eqref{Eq_tra_adv_ubs} (which corresponds to a second order centred scheme)  
    341341is evaluated using the \textit{now} tracer (centred in time) while the  
    … …  
    451451except for the pure vertical component that appears when a rotation tensor  
    452452is used. This latter term is solved implicitly together with the  
    453 vertical diffusion term (see \S\ref{DOM_nxt}). 
     453vertical diffusion term (see \S\ref{STP}). 
    454454 
    455455% ------------------------------------------------------------------------------------------------------------- 

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Chapters/Chap_ZDF.tex

    r3294 r3764  
    120120\end{equation} 
    121121 
    122 is computed from the wind stress vector $|\tau|$ and the reference dendity $ \rho_o$. 
     122is computed from the wind stress vector $|\tau|$ and the reference density $ \rho_o$. 
    123123The final $h_{e}$ is further constrained by the adjustable bounds \np{rn\_mldmin} and \np{rn\_mldmax}. 
    124124Once $h_{e}$ is computed, the vertical eddy coefficients within $h_{e}$ are set to  
    … …  
    11881188\includegraphics[width=0.90\textwidth]{./TexFiles/Figures/Fig_ZDF_M2_K1_tmx.pdf} 
    11891189\caption{  \label{Fig_ZDF_M2_K1_tmx}  
    1190 (a) M2 and (b) K2 internal wave drag energy from \citet{Carrere_Lyard_GRL03} ($W/m^2$). } 
     1190(a) M2 and (b) K1 internal wave drag energy from \citet{Carrere_Lyard_GRL03} ($W/m^2$). } 
    11911191\end{center}   \end{figure} 
    11921192%>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
    … …  
    12051205 
    12061206When \np{ln\_tmx\_itf}=true, the two key parameters $q$ and $F(z)$ are adjusted following  
    1207 the parameterisation developed by \ref{Koch-Larrouy_al_GRL07}: 
     1207the parameterisation developed by \citet{Koch-Larrouy_al_GRL07}: 
    12081208 
    12091209First, the Indonesian archipelago is a complex geographic region  
    … …  
    12191219Second, the vertical structure function, $F(z)$, is no more associated 
    12201220with a bottom intensification of the mixing, but with a maximum of  
    1221 energy available within the thermocline. \ref{Koch-Larrouy_al_GRL07}  
     1221energy available within the thermocline. \citet{Koch-Larrouy_al_GRL07}  
    12221222have suggested that the vertical distribution of the energy dissipation  
    12231223proportional to $N^2$ below the core of the thermocline and to $N$ above.  
    … …  
    12361236and vertical distributions of the mixing are adequately prescribed  
    12371237\citep{Koch-Larrouy_al_GRL07, Koch-Larrouy_al_OD08a, Koch-Larrouy_al_OD08b}. 
    1238 Note also that such a parameterisation has a sugnificant impact on the behaviour  
     1238Note also that such a parameterisation has a significant impact on the behaviour  
    12391239of global coupled GCMs \citep{Koch-Larrouy_al_CD10}. 
    12401240 

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Namelist/namasm

    r3294 r3764  
    33!----------------------------------------------------------------------- 
    44    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    5     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    65    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    76    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    1413    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    1514    niaufn    = 0          !  Type of IAU weighting function 
    16     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    1715    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    1816    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/DOC/TexFiles/Namelist/namdyn_vor

    r3294 r3764  
    22&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    33!----------------------------------------------------------------------- 
    4    ln_dynvor_ene = .false. !  enstrophy conserving scheme   
    5    ln_dynvor_ens = .false. !  energy conserving scheme     
     4   ln_dynvor_ene = .false. !  energy    conserving scheme   
     5   ln_dynvor_ens = .false. !  enstrophy conserving scheme     
    66   ln_dynvor_mix = .false. !  mixed scheme                
    77   ln_dynvor_een = .true.  !  energy & enstrophy scheme   

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/AMM12/EXP00/namelist

    r3697 r3764  
    33!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    5 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,  
     5!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    66!!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
    77!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 
    … …  
    2525!----------------------------------------------------------------------- 
    2626   nn_no       =       0   !  job number (no more used...) 
    27    cn_exp      =  "AMM12"  !  experience name  
     27   cn_exp      =  "AMM12"  !  experience name 
    2828   nn_it000    =       1   !  first time step 
    2929   nn_itend    =    2880   !  last  time step (std 1 day = 288) 
    … …  
    5252!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5353!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    54 !!   namtsd       data: temperature & salinity                          
     54!!   namtsd       data: temperature & salinity 
    5555!!====================================================================== 
    5656! 
    … …  
    107107/ 
    108108!----------------------------------------------------------------------- 
    109 &namtsd    !   data : Temperature  & Salinity                            
     109&namtsd    !   data : Temperature  & Salinity 
    110110!----------------------------------------------------------------------- 
    111111!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    … …  
    142142   ln_ana      = .false    !  analytical formulation (T => fill namsbc_ana ) 
    143143   ln_flx      = .true.    !  flux formulation       (T => fill namsbc_flx ) 
    144    ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio)  
    145    ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)  
     144   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
     145   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
    146146   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    147147   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    … …  
    156156   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
    157157   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    158    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked  
    159                            !     =1 global mean of e-p-r set to zero at each time step  
     158   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
     159                           !     =1 global mean of e-p-r set to zero at each time step 
    160160                           !     =2 annual global mean of e-p-r set to zero 
    161161                           !     =3 global emp set to zero and spread out over erp area 
    … …  
    185185   sn_emp      = 'amm12_flx'      ,          3        ,  'sowafldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  '' 
    186186   cn_dir      = './fluxes/'        !  root directory for the location of the flux files 
    187 /       
     187/ 
    188188!----------------------------------------------------------------------- 
    189189&namsbc_clio   !   namsbc_clio  CLIO bulk formulae 
    … …  
    242242!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
    243243! send 
    244 sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
    245 sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
    246 sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
    247 sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
    248 sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     244sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     245sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     246sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
     247sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     248sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    249249! receive 
    250 sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
    251 sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    252 sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
    253 sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    254 sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
    255 sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
    256 sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
    257 sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    258 sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    259 sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     250sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     251sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     252sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     253sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     254sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     255sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     256sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     257sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     258sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     259sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    260260/ 
    261261!----------------------------------------------------------------------- 
    … …  
    323323   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2) 
    324324   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
    325 /       
     325/ 
    326326!----------------------------------------------------------------------- 
    327327&namsbc_alb    !   albedo parameters 
    328328!----------------------------------------------------------------------- 
    329    rn_cloud    =    0.06   !  cloud correction to snow and ice albedo  
     329   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
    330330   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic 
    331331   rn_alphd    =    0.80   !  coefficients for linear interpolation used to 
    332    rn_alphc    =    0.65   !  compute albedo between two extremes values  
     332   rn_alphc    =    0.65   !  compute albedo between two extremes values 
    333333   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    334334/ 
    … …  
    370370!!   namcla        cross land advection 
    371371!!   namobc        open boundaries parameters                           ("key_obc") 
    372 !!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")  
     372!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
    373373!!   nambdy        Unstructured open boundaries                         ("key_bdy") 
    374374!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides") 
    … …  
    392392   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F) 
    393393   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F) 
    394    ln_obc_fla  = .false.   !  Flather open boundary condition  
     394   ln_obc_fla  = .false.   !  Flather open boundary condition 
    395395   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state 
    396396                           !  = 1 the obc data are read in 'obc.dta' files 
    … …  
    439439&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    440440!----------------------------------------------------------------------- 
    441     nb_bdy = 1                            !  number of open boundary sets        
     441    nb_bdy = 1                            !  number of open boundary sets 
    442442    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
    443443    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
    … …  
    475475/ 
    476476!----------------------------------------------------------------------- 
    477 &nambdy_tide     ! tidal forcing at open boundaries               
     477&nambdy_tide     ! tidal forcing at open boundaries 
    478478!----------------------------------------------------------------------- 
    479479   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
    … …  
    483483!!====================================================================== 
    484484!!   nambfr        bottom friction 
    485 !!   nambbc        bottom temperature boundary condition                
     485!!   nambbc        bottom temperature boundary condition 
    486486!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    487487!!====================================================================== 
    … …  
    505505!----------------------------------------------------------------------- 
    506506   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    507    nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
     507   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
    508508                           !     = 1 constant flux 
    509                            !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)  
     509                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
    510510   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2] 
    511511/ 
    … …  
    525525!!   namtra_adv    advection scheme 
    526526!!   namtra_ldf    lateral diffusion scheme 
    527 !!   namtra_dmp    T & S newtonian damping                         
     527!!   namtra_dmp    T & S newtonian damping 
    528528!!====================================================================== 
    529529! 
    … …  
    539539/ 
    540540!----------------------------------------------------------------------- 
    541 &namtra_adv    !   advection scheme for tracer  
    542 !----------------------------------------------------------------------- 
    543    ln_traadv_cen2   =  .false.  !  2nd order centered scheme    
    544    ln_traadv_tvd    =  .true.   !  TVD scheme                 
    545    ln_traadv_muscl  =  .false.  !  MUSCL scheme              
    546    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    547    ln_traadv_ubs    =  .false.  !  UBS scheme                  
    548    ln_traadv_qck    =  .false.  !  QUICKEST scheme                  
     541&namtra_adv    !   advection scheme for tracer 
     542!----------------------------------------------------------------------- 
     543   ln_traadv_cen2   =  .false.  !  2nd order centered scheme 
     544   ln_traadv_tvd    =  .true.   !  TVD scheme 
     545   ln_traadv_muscl  =  .false.  !  MUSCL scheme 
     546   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries 
     547   ln_traadv_ubs    =  .false.  !  UBS scheme 
     548   ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    549549   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
    550550/ 
    … …  
    574574/ 
    575575!----------------------------------------------------------------------- 
    576 &namtra_dmp    !   tracer: T & S newtonian damping                   
     576&namtra_dmp    !   tracer: T & S newtonian damping 
    577577!----------------------------------------------------------------------- 
    578578   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    … …  
    602602&namdyn_adv    !   formulation of the momentum advection 
    603603!----------------------------------------------------------------------- 
    604    ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)   
     604   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
    605605   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    606    ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme  
    607 /   
     606   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
     607/ 
    608608!----------------------------------------------------------------------- 
    609609&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    610610!----------------------------------------------------------------------- 
    611    ln_dynvor_ene = .false. !  enstrophy conserving scheme   
    612    ln_dynvor_ens = .false. !  energy conserving scheme     
    613    ln_dynvor_mix = .false. !  mixed scheme                
    614    ln_dynvor_een = .true.  !  energy & enstrophy scheme   
     611   ln_dynvor_ene = .false. !  energy    conserving scheme   
     612   ln_dynvor_ens = .false. !  enstrophy conserving scheme     
     613   ln_dynvor_mix = .false. !  mixed scheme 
     614   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    615615/ 
    616616!----------------------------------------------------------------------- 
    617617&namdyn_hpg    !   Hydrostatic pressure gradient option 
    618618!----------------------------------------------------------------------- 
    619    ln_hpg_zco  = .false.   !  z-coordinate - full steps                    
     619   ln_hpg_zco  = .false.   !  z-coordinate - full steps 
    620620   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation) 
    621621   ln_hpg_sco  = .false.    !  s-coordinate (standard jacobian formulation) 
    … …  
    635635&namdyn_ldf    !   lateral diffusion on momentum 
    636636!----------------------------------------------------------------------- 
    637    !                       !  Type of the operator :  
    638    ln_dynldf_lap    =  .true.   !  laplacian operator          
     637   !                       !  Type of the operator : 
     638   ln_dynldf_lap    =  .true.   !  laplacian operator 
    639639   ln_dynldf_bilap  =  .true.   !  bilaplacian operator 
    640640                           !  Direction of action  : 
    641    ln_dynldf_level  =  .false.  !  iso-level                
     641   ln_dynldf_level  =  .false.  !  iso-level 
    642642   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.) 
    643643   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp") 
    644                            !  Coefficient  
     644                           !  Coefficient 
    645645   rn_ahm_0_lap     = 60.0      !  horizontal laplacian eddy viscosity   [m2/s] 
    646646   rn_ahmb_0        =  0.0      !  background eddy viscosity for ldf_iso [m2/s] 
    … …  
    718718&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally: 
    719719!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb") 
    720    ln_kpprimix = .true.    !  shear instability mixing  
     720   ln_kpprimix = .true.    !  shear instability mixing 
    721721   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s] 
    722722   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s] 
    723723   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability 
    724724   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s] 
    725    rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2]  
    726    rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s]  
     725   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
     726   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
    727727   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv 
    728728   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt 
    … …  
    758758   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1) 
    759759   rn_tfe      = 0.333     !  tidal dissipation efficiency 
    760    rn_me       = 0.2       !  mixing efficiency  
     760   rn_me       = 0.2       !  mixing efficiency 
    761761   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation 
    762762   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency 
    … …  
    768768!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    769769!!   namctl            Control prints & Benchmark 
    770 !!   namsol            elliptic solver / island / free surface  
    771 !!====================================================================== 
    772 ! 
    773 !----------------------------------------------------------------------- 
    774 &namsol        !   elliptic solver / island / free surface  
     770!!   namsol            elliptic solver / island / free surface 
     771!!====================================================================== 
     772! 
     773!----------------------------------------------------------------------- 
     774&namsol        !   elliptic solver / island / free surface 
    775775!----------------------------------------------------------------------- 
    776776   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    … …  
    818818!!   namflo       float parameters                                      ("key_float") 
    819819!!   namptr       Poleward Transport Diagnostics 
    820 !!   namhsb       Heat and salt budgets  
     820!!   namhsb       Heat and salt budgets 
    821821!!====================================================================== 
    822822! 
    … …  
    856856   jpnnewflo     = 0          !  number of floats for the restart 
    857857   ln_rstflo     = .false.    !  float restart (T) or not (F) 
    858    nn_writefl    =      75    !  frequency of writing in float output file  
    859    nn_stockfl    =    5475    !  frequency of creation of the float restart file  
     858   nn_writefl    =      75    !  frequency of writing in float output file 
     859   nn_stockfl    =    5475    !  frequency of creation of the float restart file 
    860860   ln_argo       = .false.    !  Argo type floats (stay at the surface each 10 days) 
    861861   ln_flork4     = .false.    !  trajectories computed with a 4th order Runge-Kutta (T) 
    … …  
    869869   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    870870   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions 
    871    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
     871   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
    872872                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    873873   ln_ptrcomp = .false.    !  Add decomposition : overturning 
    … …  
    876876/ 
    877877!----------------------------------------------------------------------- 
    878 &namhsb       !  Heat and salt budgets  
     878&namhsb       !  Heat and salt budgets 
    879879!----------------------------------------------------------------------- 
    880880   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
    … …  
    908908&namobs       !  observation usage switch                               ('key_diaobs') 
    909909!----------------------------------------------------------------------- 
    910    ln_t3d     = .false.    ! Logical switch for T profile observations          
    911    ln_s3d     = .false.    ! Logical switch for S profile observations           
    912    ln_ena     = .false.    ! Logical switch for ENACT insitu data set            
    913    !                       !     ln_cor                  Logical switch for Coriolis insitu data set        
    914    ln_profb   = .false.    ! Logical switch for feedback insitu data set      
    915    ln_sla     = .false.    ! Logical switch for SLA observations                
    916  
    917    ln_sladt   = .false.    ! Logical switch for AVISO SLA data               
    918  
    919    ln_slafb   = .false.    ! Logical switch for feedback SLA data             
    920                            !     ln_ssh                  Logical switch for SSH observations               
     910   ln_t3d     = .false.    ! Logical switch for T profile observations 
     911   ln_s3d     = .false.    ! Logical switch for S profile observations 
     912   ln_ena     = .false.    ! Logical switch for ENACT insitu data set 
     913   !                       !     ln_cor                  Logical switch for Coriolis insitu data set 
     914   ln_profb   = .false.    ! Logical switch for feedback insitu data set 
     915   ln_sla     = .false.    ! Logical switch for SLA observations 
     916 
     917   ln_sladt   = .false.    ! Logical switch for AVISO SLA data 
     918 
     919   ln_slafb   = .false.    ! Logical switch for feedback SLA data 
     920                           !     ln_ssh                  Logical switch for SSH observations 
    921921 
    922922   ln_sst     = .true.     ! Logical switch for SST observations 
    … …  
    924924   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations       
    925925 
    926    ln_sstfb   = .false.    ! Logical switch for feedback SST data           
    927                            !     ln_sss                  Logical switch for SSS observations               
    928                            !     ln_seaice               Logical switch for Sea Ice observations         
    929                            !     ln_vel3d                Logical switch for velocity observations          
    930                            !     ln_velavcur             Logical switch for velocity daily av. cur.     
    931                            !     ln_velhrcur             Logical switch for velocity high freq. cur.    
    932                            !     ln_velavadcp            Logical switch for velocity daily av. ADCP   
     926   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
     927                           !     ln_sss                  Logical switch for SSS observations 
     928                           !     ln_seaice               Logical switch for Sea Ice observations 
     929                           !     ln_vel3d                Logical switch for velocity observations 
     930                           !     ln_velavcur             Logical switch for velocity daily av. cur. 
     931                           !     ln_velhrcur             Logical switch for velocity high freq. cur. 
     932                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP 
    933933                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP 
    934                            !     ln_velfb                Logical switch for feedback velocity data        
    935                            !     ln_grid_global          Global distribtion of observations          
    936                            !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table   
    937                            !     grid_search_file        Grid search lookup file header  
    938                            !     enactfiles              ENACT input observation file names  
    939                            !     coriofiles              Coriolis input observation file name   
    940    !                       ! profbfiles: Profile feedback input observation file name  
     934                           !     ln_velfb                Logical switch for feedback velocity data 
     935                           !     ln_grid_global          Global distribtion of observations 
     936                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table 
     937                           !     grid_search_file        Grid search lookup file header 
     938                           !     enactfiles              ENACT input observation file names 
     939                           !     coriofiles              Coriolis input observation file name 
     940   !                       ! profbfiles: Profile feedback input observation file name 
    941941   profbfiles = 'profiles_01.nc' 
    942                            !     ln_profb_enatim         Enact feedback input time setting switch     
     942                           !     ln_profb_enatim         Enact feedback input time setting switch 
    943943                           !     slafilesact             Active SLA input observation file name 
    944                            !     slafilespas             Passive SLA input observation file name  
    945    !                       ! slafbfiles: Feedback SLA input observation file name  
     944                           !     slafilespas             Passive SLA input observation file name 
     945   !                       ! slafbfiles: Feedback SLA input observation file name 
    946946   slafbfiles = 'sla_01.nc' 
    947                            !     sstfiles                GHRSST input observation file name        
    948    !                       ! sstfbfiles: Feedback SST input observation file name  
     947                           !     sstfiles                GHRSST input observation file name 
     948   !                       ! sstfbfiles: Feedback SST input observation file name 
    949949   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc' 
    950                            !     seaicefiles             Sea Ice input observation file name  
    951                            !     velavcurfiles           Vel. cur. daily av. input file name   
    952                            !     velhvcurfiles           Vel. cur. high freq. input file name   
    953                            !     velavadcpfiles          Vel. ADCP daily av. input file name     
    954                            !     velhvadcpfiles          Vel. ADCP high freq. input file name  
    955                            !     velfbfiles              Vel. feedback input observation file name  
    956                            !     dobsini                 Initial date in window YYYYMMDD.HHMMSS        
    957                            !     dobsend                 Final date in window YYYYMMDD.HHMMSS          
    958                            !     n1dint                  Type of vertical interpolation method         
    959                            !     n2dint                  Type of horizontal interpolation method        
    960                            !     ln_nea                  Rejection of observations near land switch     
    961    nmsshc     = 0          ! MSSH correction scheme                          
    962                            !     mdtcorr                 MDT  correction                                
    963                            !     mdtcutoff               MDT cutoff for computed correction           
    964    ln_altbias = .false.    ! Logical switch for alt bias                 
    965    ln_ignmis  = .true.     ! Logical switch for ignoring missing files    
    966                            !     endailyavtypes   ENACT daily average types                     
     950                           !     seaicefiles             Sea Ice input observation file name 
     951                           !     velavcurfiles           Vel. cur. daily av. input file name 
     952                           !     velhvcurfiles           Vel. cur. high freq. input file name 
     953                           !     velavadcpfiles          Vel. ADCP daily av. input file name 
     954                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
     955                           !     velfbfiles              Vel. feedback input observation file name 
     956                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS 
     957                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS 
     958                           !     n1dint                  Type of vertical interpolation method 
     959                           !     n2dint                  Type of horizontal interpolation method 
     960                           !     ln_nea                  Rejection of observations near land switch 
     961   nmsshc     = 0          ! MSSH correction scheme 
     962                           !     mdtcorr                 MDT  correction 
     963                           !     mdtcutoff               MDT cutoff for computed correction 
     964   ln_altbias = .false.    ! Logical switch for alt bias 
     965   ln_ignmis  = .true.     ! Logical switch for ignoring missing files 
     966                           !     endailyavtypes   ENACT daily average types 
    967967   ln_grid_global = .true. 
    968968   ln_grid_search_lookup = .false. 
    969 /  
     969/ 
    970970!----------------------------------------------------------------------- 
    971971&nam_asminc   !   assimilation increments                               ('key_asminc') 
    972972!----------------------------------------------------------------------- 
    973     ln_bkgwri = .false.    !  Logical switch for writing out background state  
    974     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
     973    ln_bkgwri = .false.    !  Logical switch for writing out background state 
    975974    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    976975    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    977     ln_sshinc = .false.    !  Logical switch for applying SSH increments  
     976    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
    978977    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI) 
    979978    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU) 
    … …  
    983982    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    984983    niaufn    = 0          !  Type of IAU weighting function 
    985     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    986984    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    987985    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r3680 r3764  
    33!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    5 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,  
     5!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    66!!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
    77!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 
    … …  
    2525!----------------------------------------------------------------------- 
    2626   nn_no       =       0   !  job number (no more used...) 
    27    cn_exp      =  "GYRE"   !  experience name  
     27   cn_exp      =  "GYRE"   !  experience name 
    2828   nn_it000    =       1   !  first time step 
    2929   nn_itend    =    4320   !  last  time step 
    … …  
    5252!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5353!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    54 !!   namtsd       data: temperature & salinity          
     54!!   namtsd       data: temperature & salinity 
    5555!!====================================================================== 
    5656! 
    … …  
    107107/ 
    108108!----------------------------------------------------------------------- 
    109 &namtsd    !   data : Temperature  & Salinity                            
     109&namtsd    !   data : Temperature  & Salinity 
    110110!----------------------------------------------------------------------- 
    111111!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    … …  
    138138&namsbc        !   Surface Boundary Condition (surface module) 
    139139!----------------------------------------------------------------------- 
    140    nn_fsbc     = 1         !  frequency of surface boundary condition computation  
     140   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    141141                           !     (also = the frequency of sea-ice model call) 
    142    ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana )  
     142   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    143143   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx ) 
    144    ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio)  
    145    ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)  
     144   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
     145   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
    146146   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    147147   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    … …  
    156156   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 
    157157   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    158    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked  
    159                            !     =1 global mean of e-p-r set to zero at each time step  
     158   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
     159                           !     =1 global mean of e-p-r set to zero at each time step 
    160160                           !     =2 annual global mean of e-p-r set to zero 
    161161                           !     =3 global emp set to zero and spread out over erp area 
    … …  
    186186 
    187187   cn_dir      = './'      !  root directory for the location of the flux files 
    188 /       
     188/ 
    189189!----------------------------------------------------------------------- 
    190190&namsbc_clio   !   namsbc_clio  CLIO bulk formulae 
    … …  
    243243!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
    244244! send 
    245 sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
    246 sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
    247 sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
    248 sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
    249 sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     245sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     246sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     247sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
     248sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     249sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    250250! receive 
    251 sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
    252 sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    253 sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
    254 sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    255 sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
    256 sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
    257 sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
    258 sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    259 sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    260 sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     251sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     252sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     253sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     254sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     255sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     256sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     257sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     258sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     259sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     260sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    261261/ 
    262262!----------------------------------------------------------------------- 
    … …  
    266266!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
    267267   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , '' 
    268   
     268 
    269269   cn_dir      = './'      !  root directory for the location of the runoff files 
    270270   ln_traqsr   = .true.    !  Light penetration (T) or not (F) 
    … …  
    315315   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , '' 
    316316   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , '' 
    317      
     317 
    318318   cn_dir      = './'      !  root directory for the location of the runoff files 
    319319   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0) 
    … …  
    324324   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2) 
    325325   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
    326 /       
     326/ 
    327327!----------------------------------------------------------------------- 
    328328&namsbc_alb    !   albedo parameters 
    329329!----------------------------------------------------------------------- 
    330    rn_cloud    =    0.06   !  cloud correction to snow and ice albedo  
     330   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
    331331   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic 
    332332   rn_alphd    =    0.80   !  coefficients for linear interpolation used to 
    333    rn_alphc    =    0.65   !  compute albedo between two extremes values  
     333   rn_alphc    =    0.65   !  compute albedo between two extremes values 
    334334   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    335335/ 
    … …  
    375375!!   namcla        cross land advection 
    376376!!   namobc        open boundaries parameters                           ("key_obc") 
    377 !!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")  
     377!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
    378378!!   nambdy        Unstructured open boundaries                         ("key_bdy") 
    379379!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides") 
    … …  
    397397   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F) 
    398398   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F) 
    399    ln_obc_fla  = .false.   !  Flather open boundary condition  
     399   ln_obc_fla  = .false.   !  Flather open boundary condition 
    400400   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state 
    401401                           !  = 1 the obc data are read in 'obc.dta' files 
    … …  
    446446&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    447447!----------------------------------------------------------------------- 
    448     nb_bdy = 1                            !  number of open boundary sets        
     448    nb_bdy = 1                            !  number of open boundary sets 
    449449    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
    450450    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
    … …  
    482482/ 
    483483!----------------------------------------------------------------------- 
    484 &nambdy_tide     ! tidal forcing at open boundaries               
     484&nambdy_tide     ! tidal forcing at open boundaries 
    485485!----------------------------------------------------------------------- 
    486486   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
    … …  
    521521!!====================================================================== 
    522522!!   nambfr        bottom friction 
    523 !!   nambbc        bottom temperature boundary condition                
     523!!   nambbc        bottom temperature boundary condition 
    524524!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    525525!!====================================================================== 
    … …  
    541541!----------------------------------------------------------------------- 
    542542   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    543    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux  
     543   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
    544544                           !     = 1 constant flux 
    545                            !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)  
     545                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
    546546   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2] 
    547547/ 
    … …  
    561561!!   namtra_adv    advection scheme 
    562562!!   namtra_ldf    lateral diffusion scheme 
    563 !!   namtra_dmp    T & S newtonian damping                         
     563!!   namtra_dmp    T & S newtonian damping 
    564564!!====================================================================== 
    565565! 
    … …  
    575575/ 
    576576!----------------------------------------------------------------------- 
    577 &namtra_adv    !   advection scheme for tracer  
    578 !----------------------------------------------------------------------- 
    579    ln_traadv_cen2   =  .false.  !  2nd order centered scheme    
    580    ln_traadv_tvd    =  .true.   !  TVD scheme                 
    581    ln_traadv_muscl  =  .false.  !  MUSCL scheme              
    582    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    583    ln_traadv_ubs    =  .false.  !  UBS scheme                  
    584    ln_traadv_qck    =  .false.  !  QUICKEST scheme                  
     577&namtra_adv    !   advection scheme for tracer 
     578!----------------------------------------------------------------------- 
     579   ln_traadv_cen2   =  .false.  !  2nd order centered scheme 
     580   ln_traadv_tvd    =  .true.   !  TVD scheme 
     581   ln_traadv_muscl  =  .false.  !  MUSCL scheme 
     582   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries 
     583   ln_traadv_ubs    =  .false.  !  UBS scheme 
     584   ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    585585   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl  
    586586/ 
    … …  
    610610/ 
    611611!----------------------------------------------------------------------- 
    612 &namtra_dmp    !   tracer: T & S newtonian damping                       
     612&namtra_dmp    !   tracer: T & S newtonian damping 
    613613!----------------------------------------------------------------------- 
    614614   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    … …  
    638638&namdyn_adv    !   formulation of the momentum advection 
    639639!----------------------------------------------------------------------- 
    640    ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)   
     640   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
    641641   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    642    ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme  
    643 /   
     642   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
     643/ 
    644644!----------------------------------------------------------------------- 
    645645&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    646646!----------------------------------------------------------------------- 
    647    ln_dynvor_ene = .true.  !  enstrophy conserving scheme   
    648    ln_dynvor_ens = .false. !  energy conserving scheme     
    649    ln_dynvor_mix = .false. !  mixed scheme                
    650    ln_dynvor_een = .false. !  energy & enstrophy scheme   
     647   ln_dynvor_ene = .true.  !  energy    conserving scheme   
     648   ln_dynvor_ens = .false. !  enstrophy conserving scheme     
     649   ln_dynvor_mix = .false. !  mixed scheme 
     650   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    651651/ 
    652652!----------------------------------------------------------------------- 
    653653&namdyn_hpg    !   Hydrostatic pressure gradient option 
    654654!----------------------------------------------------------------------- 
    655    ln_hpg_zco  = .true.    !  z-coordinate - full steps                    
     655   ln_hpg_zco  = .true.    !  z-coordinate - full steps 
    656656   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation) 
    657657   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    … …  
    671671&namdyn_ldf    !   lateral diffusion on momentum 
    672672!----------------------------------------------------------------------- 
    673    !                       !  Type of the operator :  
    674    ln_dynldf_lap    =  .true.   !  laplacian operator          
    675    ln_dynldf_bilap  =  .false.  !  bilaplacian operator     
    676    !                       !  Direction of action  :  
    677    ln_dynldf_level  =  .false.  !  iso-level                
     673   !                       !  Type of the operator : 
     674   ln_dynldf_lap    =  .true.   !  laplacian operator 
     675   ln_dynldf_bilap  =  .false.  !  bilaplacian operator 
     676   !                       !  Direction of action  : 
     677   ln_dynldf_level  =  .false.  !  iso-level 
    678678   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.) 
    679679   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp") 
    … …  
    754754&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally: 
    755755!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb") 
    756    ln_kpprimix = .true.    !  shear instability mixing  
     756   ln_kpprimix = .true.    !  shear instability mixing 
    757757   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s] 
    758758   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s] 
    759759   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability 
    760760   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s] 
    761    rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2]  
    762    rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s]  
     761   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
     762   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
    763763   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv 
    764764   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt 
    … …  
    794794   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1) 
    795795   rn_tfe      = 0.333     !  tidal dissipation efficiency 
    796    rn_me       = 0.2       !  mixing efficiency  
     796   rn_me       = 0.2       !  mixing efficiency 
    797797   ln_tmx_itf  = .false.   !  ITF specific parameterisation 
    798798   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency 
    … …  
    804804!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    805805!!   namctl            Control prints & Benchmark 
    806 !!   namsol            elliptic solver / island / free surface  
    807 !!====================================================================== 
    808 ! 
    809 !----------------------------------------------------------------------- 
    810 &namsol        !   elliptic solver / island / free surface  
     806!!   namsol            elliptic solver / island / free surface 
     807!!====================================================================== 
     808! 
     809!----------------------------------------------------------------------- 
     810&namsol        !   elliptic solver / island / free surface 
    811811!----------------------------------------------------------------------- 
    812812   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    … …  
    827827   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation 
    828828   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold 
    829    jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)      
    830    jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)      
    831    jpnij       =   0       !  jpnij  number of local domains (set automatically if < 1)               
     829   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1) 
     830   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1) 
     831   jpnij       =   0       !  jpnij  number of local domains (set automatically if < 1) 
    832832/ 
    833833!----------------------------------------------------------------------- 
    … …  
    854854!!   namflo       float parameters                                      ("key_float") 
    855855!!   namptr       Poleward Transport Diagnostics 
    856 !!   namhsb       Heat and salt budgets  
     856!!   namhsb       Heat and salt budgets 
    857857!!====================================================================== 
    858858! 
    … …  
    899899   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    900900   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    901    ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not  
     901   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
    902902                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    903903   ln_ptrcomp = .true.     !  Add decomposition : overturning 
    … …  
    906906/ 
    907907!----------------------------------------------------------------------- 
    908 &namhsb       !  Heat and salt budgets  
     908&namhsb       !  Heat and salt budgets 
    909909!----------------------------------------------------------------------- 
    910910   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
    … …  
    918918                           !     -1 : debug all section 
    919919                           !  0 < n : debug section number n 
    920 /  
     920/ 
    921921 
    922922!!====================================================================== 
    … …  
    930930&namobs       !  observation usage switch                               ('key_diaobs') 
    931931!----------------------------------------------------------------------- 
    932    ln_t3d     = .false.    ! Logical switch for T profile observations          
    933    ln_s3d     = .false.    ! Logical switch for S profile observations           
    934    ln_ena     = .false.    ! Logical switch for ENACT insitu data set            
    935    !                       !     ln_cor                  Logical switch for Coriolis insitu data set        
    936    ln_profb   = .false.    ! Logical switch for feedback insitu data set      
    937    ln_sla     = .false.    ! Logical switch for SLA observations                
    938  
    939    ln_sladt   = .false.    ! Logical switch for AVISO SLA data               
    940  
    941    ln_slafb   = .false.    ! Logical switch for feedback SLA data             
    942                            !     ln_ssh                  Logical switch for SSH observations               
     932   ln_t3d     = .false.    ! Logical switch for T profile observations 
     933   ln_s3d     = .false.    ! Logical switch for S profile observations 
     934   ln_ena     = .false.    ! Logical switch for ENACT insitu data set 
     935   !                       !     ln_cor                  Logical switch for Coriolis insitu data set 
     936   ln_profb   = .false.    ! Logical switch for feedback insitu data set 
     937   ln_sla     = .false.    ! Logical switch for SLA observations 
     938 
     939   ln_sladt   = .false.    ! Logical switch for AVISO SLA data 
     940 
     941   ln_slafb   = .false.    ! Logical switch for feedback SLA data 
     942                           !     ln_ssh                  Logical switch for SSH observations 
    943943 
    944944   ln_sst     = .true.     ! Logical switch for SST observations               
    … …  
    946946   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations           
    947947 
    948    ln_sstfb   = .false.    ! Logical switch for feedback SST data           
    949                            !     ln_sss                  Logical switch for SSS observations               
    950                            !     ln_seaice               Logical switch for Sea Ice observations         
    951                            !     ln_vel3d                Logical switch for velocity observations          
    952                            !     ln_velavcur             Logical switch for velocity daily av. cur.     
    953                            !     ln_velhrcur             Logical switch for velocity high freq. cur.    
    954                            !     ln_velavadcp            Logical switch for velocity daily av. ADCP   
     948   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
     949                           !     ln_sss                  Logical switch for SSS observations 
     950                           !     ln_seaice               Logical switch for Sea Ice observations 
     951                           !     ln_vel3d                Logical switch for velocity observations 
     952                           !     ln_velavcur             Logical switch for velocity daily av. cur. 
     953                           !     ln_velhrcur             Logical switch for velocity high freq. cur. 
     954                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP 
    955955                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP 
    956                            !     ln_velfb                Logical switch for feedback velocity data        
    957                            !     ln_grid_global          Global distribtion of observations          
    958                            !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table   
    959                            !     grid_search_file        Grid search lookup file header  
    960                            !     enactfiles              ENACT input observation file names  
    961                            !     coriofiles              Coriolis input observation file name   
    962    !                       ! profbfiles: Profile feedback input observation file name  
     956                           !     ln_velfb                Logical switch for feedback velocity data 
     957                           !     ln_grid_global          Global distribtion of observations 
     958                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table 
     959                           !     grid_search_file        Grid search lookup file header 
     960                           !     enactfiles              ENACT input observation file names 
     961                           !     coriofiles              Coriolis input observation file name 
     962   !                       ! profbfiles: Profile feedback input observation file name 
    963963   profbfiles = 'profiles_01.nc' 
    964                            !     ln_profb_enatim         Enact feedback input time setting switch     
     964                           !     ln_profb_enatim         Enact feedback input time setting switch 
    965965                           !     slafilesact             Active SLA input observation file name 
    966                            !     slafilespas             Passive SLA input observation file name  
    967    !                       ! slafbfiles: Feedback SLA input observation file name  
     966                           !     slafilespas             Passive SLA input observation file name 
     967   !                       ! slafbfiles: Feedback SLA input observation file name 
    968968   slafbfiles = 'sla_01.nc' 
    969                            !     sstfiles                GHRSST input observation file name        
    970    !                       ! sstfbfiles: Feedback SST input observation file name  
     969                           !     sstfiles                GHRSST input observation file name 
     970   !                       ! sstfbfiles: Feedback SST input observation file name 
    971971   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc' 
    972                            !     seaicefiles             Sea Ice input observation file name  
    973                            !     velavcurfiles           Vel. cur. daily av. input file name   
    974                            !     velhvcurfiles           Vel. cur. high freq. input file name   
    975                            !     velavadcpfiles          Vel. ADCP daily av. input file name     
    976                            !     velhvadcpfiles          Vel. ADCP high freq. input file name  
    977                            !     velfbfiles              Vel. feedback input observation file name  
    978                            !     dobsini                 Initial date in window YYYYMMDD.HHMMSS        
    979                            !     dobsend                 Final date in window YYYYMMDD.HHMMSS          
    980                            !     n1dint                  Type of vertical interpolation method         
    981                            !     n2dint                  Type of horizontal interpolation method        
    982                            !     ln_nea                  Rejection of observations near land switch     
    983    nmsshc     = 0          ! MSSH correction scheme                          
    984                            !     mdtcorr                 MDT  correction                                
    985                            !     mdtcutoff               MDT cutoff for computed correction           
    986    ln_altbias = .false.    ! Logical switch for alt bias                 
    987    ln_ignmis  = .true.     ! Logical switch for ignoring missing files    
    988                            !     endailyavtypes   ENACT daily average types                     
     972                           !     seaicefiles             Sea Ice input observation file name 
     973                           !     velavcurfiles           Vel. cur. daily av. input file name 
     974                           !     velhvcurfiles           Vel. cur. high freq. input file name 
     975                           !     velavadcpfiles          Vel. ADCP daily av. input file name 
     976                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
     977                           !     velfbfiles              Vel. feedback input observation file name 
     978                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS 
     979                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS 
     980                           !     n1dint                  Type of vertical interpolation method 
     981                           !     n2dint                  Type of horizontal interpolation method 
     982                           !     ln_nea                  Rejection of observations near land switch 
     983   nmsshc     = 0          ! MSSH correction scheme 
     984                           !     mdtcorr                 MDT  correction 
     985                           !     mdtcutoff               MDT cutoff for computed correction 
     986   ln_altbias = .false.    ! Logical switch for alt bias 
     987   ln_ignmis  = .true.     ! Logical switch for ignoring missing files 
     988                           !     endailyavtypes   ENACT daily average types 
    989989   ln_grid_global = .true. 
    990990   ln_grid_search_lookup = .false. 
    991 /  
     991/ 
    992992!----------------------------------------------------------------------- 
    993993&nam_asminc   !   assimilation increments                               ('key_asminc') 
    994994!----------------------------------------------------------------------- 
    995     ln_bkgwri = .false.    !  Logical switch for writing out background state  
    996     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
     995    ln_bkgwri = .false.    !  Logical switch for writing out background state 
    997996    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    998997    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    999     ln_sshinc = .false.    !  Logical switch for applying SSH increments  
     998    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
    1000999    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI) 
    10011000    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU) 
    … …  
    10051004    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    10061005    niaufn    = 0          !  Type of IAU weighting function 
    1007     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    10081006    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    10091007    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist

    r3744 r3764  
    935935!----------------------------------------------------------------------- 
    936936    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    937     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    938937    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    939938    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    946945    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    947946    niaufn    = 0          !  Type of IAU weighting function 
    948     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    949947    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    950948    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist

    r3680 r3764  
    592592&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    593593!----------------------------------------------------------------------- 
    594    ln_dynvor_ene = .false. !  enstrophy conserving scheme   
    595    ln_dynvor_ens = .false. !  energy conserving scheme     
     594   ln_dynvor_ene = .false. !  energy    conserving scheme   
     595   ln_dynvor_ens = .false. !  enstrophy conserving scheme     
    596596   ln_dynvor_mix = .false. !  mixed scheme                
    597597   ln_dynvor_een = .true.  !  energy & enstrophy scheme   
    … …  
    930930!----------------------------------------------------------------------- 
    931931    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    932     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    933932    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    934933    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    941940    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    942941    niaufn    = 0          !  Type of IAU weighting function 
    943     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    944942    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    945943    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r3680 r3764  
    33!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    5 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,  
     5!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    66!!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
    77!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 
    … …  
    2525!----------------------------------------------------------------------- 
    2626   nn_no       =       0   !  job number (no more used...) 
    27    cn_exp      =  "ORCA2"  !  experience name  
     27   cn_exp      =  "ORCA2"  !  experience name 
    2828   nn_it000    =       1   !  first time step 
    2929   nn_itend    =    5475   !  last  time step (std 5475) 
    … …  
    5252!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5353!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    54 !!   namtsd       data: temperature & salinity                          
     54!!   namtsd       data: temperature & salinity 
    5555!!====================================================================== 
    5656! 
    … …  
    107107/ 
    108108!----------------------------------------------------------------------- 
    109 &namtsd    !   data : Temperature  & Salinity                            
     109&namtsd    !   data : Temperature  & Salinity 
    110110!----------------------------------------------------------------------- 
    111111!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    … …  
    138138&namsbc        !   Surface Boundary Condition (surface module) 
    139139!----------------------------------------------------------------------- 
    140    nn_fsbc     = 5         !  frequency of surface boundary condition computation  
     140   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
    141141                           !     (also = the frequency of sea-ice model call) 
    142    ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )  
     142   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
    143143   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx ) 
    144    ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio)  
    145    ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)  
     144   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
     145   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    146146   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    147147   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    … …  
    156156   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
    157157   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    158    nn_fwb      = 3         !  FreshWater Budget: =0 unchecked  
    159                            !     =1 global mean of e-p-r set to zero at each time step  
     158   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
     159                           !     =1 global mean of e-p-r set to zero at each time step 
    160160                           !     =2 annual global mean of e-p-r set to zero 
    161161                           !     =3 global emp set to zero and spread out over erp area 
    … …  
    186186 
    187187   cn_dir      = './'      !  root directory for the location of the flux files 
    188 /       
     188/ 
    189189!----------------------------------------------------------------------- 
    190190&namsbc_clio   !   namsbc_clio  CLIO bulk formulae 
    … …  
    243243!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
    244244! send 
    245 sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
    246 sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
    247 sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
    248 sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
    249 sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     245sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     246sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     247sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
     248sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     249sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    250250! receive 
    251 sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
    252 sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    253 sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
    254 sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    255 sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
    256 sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
    257 sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
    258 sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    259 sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    260 sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     251sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     252sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     253sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     254sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     255sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     256sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     257sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     258sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     259sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     260sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    261261/ 
    262262!----------------------------------------------------------------------- 
    … …  
    318318   cn_dir      = './'      !  root directory for the location of the runoff files 
    319319   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0) 
    320    nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2)  
     320   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
    321321                           !  or to SSS only (=1) or no damping term (=0) 
    322322   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K] 
    … …  
    324324   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2) 
    325325   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
    326 /       
     326/ 
    327327!----------------------------------------------------------------------- 
    328328&namsbc_alb    !   albedo parameters 
    329329!----------------------------------------------------------------------- 
    330    rn_cloud    =    0.06   !  cloud correction to snow and ice albedo  
     330   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
    331331   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic 
    332332   rn_alphd    =    0.80   !  coefficients for linear interpolation used to 
    333    rn_alphc    =    0.65   !  compute albedo between two extremes values  
     333   rn_alphc    =    0.65   !  compute albedo between two extremes values 
    334334   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    335335/ 
    … …  
    375375!!   namcla        cross land advection 
    376376!!   namobc        open boundaries parameters                           ("key_obc") 
    377 !!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")  
     377!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
    378378!!   nambdy        Unstructured open boundaries                         ("key_bdy") 
    379379!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides") 
    … …  
    397397   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F) 
    398398   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F) 
    399    ln_obc_fla  = .false.   !  Flather open boundary condition  
     399   ln_obc_fla  = .false.   !  Flather open boundary condition 
    400400   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state 
    401401                           !  = 1 the obc data are read in 'obc.dta' files 
    … …  
    441441&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    442442!----------------------------------------------------------------------- 
    443     nb_bdy = 1                            !  number of open boundary sets        
     443    nb_bdy = 1                            !  number of open boundary sets 
    444444    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
    445445    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
    … …  
    477477/ 
    478478!----------------------------------------------------------------------- 
    479 &nambdy_tide     ! tidal forcing at open boundaries               
     479&nambdy_tide     ! tidal forcing at open boundaries 
    480480!----------------------------------------------------------------------- 
    481481   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
    … …  
    516516!!====================================================================== 
    517517!!   nambfr        bottom friction 
    518 !!   nambbc        bottom temperature boundary condition                
     518!!   nambbc        bottom temperature boundary condition 
    519519!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    520520!!====================================================================== 
    … …  
    536536!----------------------------------------------------------------------- 
    537537   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    538    nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
     538   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
    539539                           !     = 1 constant flux 
    540                            !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)  
     540                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
    541541   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2] 
    542542/ 
    … …  
    556556!!   namtra_adv    advection scheme 
    557557!!   namtra_ldf    lateral diffusion scheme 
    558 !!   namtra_dmp    T & S newtonian damping                         
     558!!   namtra_dmp    T & S newtonian damping 
    559559!!====================================================================== 
    560560! 
    … …  
    570570/ 
    571571!----------------------------------------------------------------------- 
    572 &namtra_adv    !   advection scheme for tracer  
    573 !----------------------------------------------------------------------- 
    574    ln_traadv_cen2   =  .false.  !  2nd order centered scheme    
    575    ln_traadv_tvd    =  .true.   !  TVD scheme                 
    576    ln_traadv_muscl  =  .false.  !  MUSCL scheme              
    577    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    578    ln_traadv_ubs    =  .false.  !  UBS scheme                  
    579    ln_traadv_qck    =  .false.  !  QUICKEST scheme                  
     572&namtra_adv    !   advection scheme for tracer 
     573!----------------------------------------------------------------------- 
     574   ln_traadv_cen2   =  .false.  !  2nd order centered scheme 
     575   ln_traadv_tvd    =  .true.   !  TVD scheme 
     576   ln_traadv_muscl  =  .false.  !  MUSCL scheme 
     577   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries 
     578   ln_traadv_ubs    =  .false.  !  UBS scheme 
     579   ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    580580   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
    581581/ 
    … …  
    605605/ 
    606606!----------------------------------------------------------------------- 
    607 &namtra_dmp    !   tracer: T & S newtonian damping                   
     607&namtra_dmp    !   tracer: T & S newtonian damping 
    608608!----------------------------------------------------------------------- 
    609609   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F) 
    … …  
    633633&namdyn_adv    !   formulation of the momentum advection 
    634634!----------------------------------------------------------------------- 
    635    ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)   
     635   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
    636636   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    637    ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme  
    638 /   
     637   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
     638/ 
    639639!----------------------------------------------------------------------- 
    640640&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    641641!----------------------------------------------------------------------- 
    642    ln_dynvor_ene = .false. !  enstrophy conserving scheme   
    643    ln_dynvor_ens = .false. !  energy conserving scheme     
    644    ln_dynvor_mix = .false. !  mixed scheme                
    645    ln_dynvor_een = .true.  !  energy & enstrophy scheme   
     642   ln_dynvor_ene = .false. !  enstrophy conserving scheme 
     643   ln_dynvor_ens = .false. !  energy conserving scheme 
     644   ln_dynvor_mix = .false. !  mixed scheme 
     645   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    646646/ 
    647647!----------------------------------------------------------------------- 
    648648&namdyn_hpg    !   Hydrostatic pressure gradient option 
    649649!----------------------------------------------------------------------- 
    650    ln_hpg_zco  = .false.   !  z-coordinate - full steps                    
     650   ln_hpg_zco  = .false.   !  z-coordinate - full steps 
    651651   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation) 
    652652   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    … …  
    666666&namdyn_ldf    !   lateral diffusion on momentum 
    667667!----------------------------------------------------------------------- 
    668    !                       !  Type of the operator :  
    669    ln_dynldf_lap    =  .true.   !  laplacian operator          
    670    ln_dynldf_bilap  =  .false.  !  bilaplacian operator     
    671    !                       !  Direction of action  :  
    672    ln_dynldf_level  =  .false.  !  iso-level                
     668   !                       !  Type of the operator : 
     669   ln_dynldf_lap    =  .true.   !  laplacian operator 
     670   ln_dynldf_bilap  =  .false.  !  bilaplacian operator 
     671   !                       !  Direction of action  : 
     672   ln_dynldf_level  =  .false.  !  iso-level 
    673673   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.) 
    674674   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp") 
    … …  
    676676   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s] 
    677677   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s] 
    678    rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s]  
     678   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
    679679/ 
    680680 
    … …  
    749749&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally: 
    750750!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb") 
    751    ln_kpprimix = .true.    !  shear instability mixing  
     751   ln_kpprimix = .true.    !  shear instability mixing 
    752752   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s] 
    753753   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s] 
    754754   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability 
    755755   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s] 
    756    rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2]  
    757    rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s]  
     756   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
     757   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
    758758   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv 
    759759   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt 
    … …  
    789789   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1) 
    790790   rn_tfe      = 0.333     !  tidal dissipation efficiency 
    791    rn_me       = 0.2       !  mixing efficiency  
     791   rn_me       = 0.2       !  mixing efficiency 
    792792   ln_tmx_itf  = .true.    !  ITF specific parameterisation 
    793793   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency 
    … …  
    799799!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    800800!!   namctl            Control prints & Benchmark 
    801 !!   namsol            elliptic solver / island / free surface  
    802 !!====================================================================== 
    803 ! 
    804 !----------------------------------------------------------------------- 
    805 &namsol        !   elliptic solver / island / free surface  
     801!!   namsol            elliptic solver / island / free surface 
     802!!====================================================================== 
     803! 
     804!----------------------------------------------------------------------- 
     805&namsol        !   elliptic solver / island / free surface 
    806806!----------------------------------------------------------------------- 
    807807   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg) 
    … …  
    849849!!   namflo       float parameters                                      ("key_float") 
    850850!!   namptr       Poleward Transport Diagnostics 
    851 !!   namhsb       Heat and salt budgets  
     851!!   namhsb       Heat and salt budgets 
    852852!!====================================================================== 
    853853! 
    … …  
    881881   jpnnewflo     = 0          !  number of floats for the restart 
    882882   ln_rstflo     = .false.    !  float restart (T) or not (F) 
    883    nn_writefl    =      75    !  frequency of writing in float output file  
    884    nn_stockfl    =    5475    !  frequency of creation of the float restart file  
     883   nn_writefl    =      75    !  frequency of writing in float output file 
     884   nn_stockfl    =    5475    !  frequency of creation of the float restart file 
    885885   ln_argo       = .false.    !  Argo type floats (stay at the surface each 10 days) 
    886886   ln_flork4     = .false.    !  trajectories computed with a 4th order Runge-Kutta (T) 
    … …  
    894894   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    895895   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    896    ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not  
     896   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
    897897                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    898898   ln_ptrcomp = .true.     !  Add decomposition : overturning 
    … …  
    901901/ 
    902902!----------------------------------------------------------------------- 
    903 &namhsb       !  Heat and salt budgets  
     903&namhsb       !  Heat and salt budgets 
    904904!----------------------------------------------------------------------- 
    905905   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
    … …  
    934934&namobs       !  observation usage switch                               ('key_diaobs') 
    935935!----------------------------------------------------------------------- 
    936    ln_t3d     = .false.    ! Logical switch for T profile observations          
    937    ln_s3d     = .false.    ! Logical switch for S profile observations           
    938    ln_ena     = .false.    ! Logical switch for ENACT insitu data set            
    939    !                       !     ln_cor                  Logical switch for Coriolis insitu data set        
    940    ln_profb   = .false.    ! Logical switch for feedback insitu data set      
    941    ln_sla     = .false.    ! Logical switch for SLA observations                
    942  
    943    ln_sladt   = .false.    ! Logical switch for AVISO SLA data               
    944  
    945    ln_slafb   = .false.    ! Logical switch for feedback SLA data             
    946                            !     ln_ssh                  Logical switch for SSH observations               
     936   ln_t3d     = .false.    ! Logical switch for T profile observations 
     937   ln_s3d     = .false.    ! Logical switch for S profile observations 
     938   ln_ena     = .false.    ! Logical switch for ENACT insitu data set 
     939   !                       !     ln_cor                  Logical switch for Coriolis insitu data set 
     940   ln_profb   = .false.    ! Logical switch for feedback insitu data set 
     941   ln_sla     = .false.    ! Logical switch for SLA observations 
     942 
     943   ln_sladt   = .false.    ! Logical switch for AVISO SLA data 
     944 
     945   ln_slafb   = .false.    ! Logical switch for feedback SLA data 
     946                           !     ln_ssh                  Logical switch for SSH observations 
    947947 
    948948   ln_sst     = .true.     ! Logical switch for SST observations 
    … …  
    950950   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations       
    951951 
    952    ln_sstfb   = .false.    ! Logical switch for feedback SST data           
    953                            !     ln_sss                  Logical switch for SSS observations               
    954                            !     ln_seaice               Logical switch for Sea Ice observations         
    955                            !     ln_vel3d                Logical switch for velocity observations          
    956                            !     ln_velavcur             Logical switch for velocity daily av. cur.     
    957                            !     ln_velhrcur             Logical switch for velocity high freq. cur.    
    958                            !     ln_velavadcp            Logical switch for velocity daily av. ADCP   
     952   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
     953                           !     ln_sss                  Logical switch for SSS observations 
     954                           !     ln_seaice               Logical switch for Sea Ice observations 
     955                           !     ln_vel3d                Logical switch for velocity observations 
     956                           !     ln_velavcur             Logical switch for velocity daily av. cur. 
     957                           !     ln_velhrcur             Logical switch for velocity high freq. cur. 
     958                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP 
    959959                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP 
    960                            !     ln_velfb                Logical switch for feedback velocity data        
    961                            !     ln_grid_global          Global distribtion of observations          
    962                            !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table   
    963                            !     grid_search_file        Grid search lookup file header  
    964                            !     enactfiles              ENACT input observation file names  
    965                            !     coriofiles              Coriolis input observation file name   
    966    !                       ! profbfiles: Profile feedback input observation file name  
     960                           !     ln_velfb                Logical switch for feedback velocity data 
     961                           !     ln_grid_global          Global distribtion of observations 
     962                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table 
     963                           !     grid_search_file        Grid search lookup file header 
     964                           !     enactfiles              ENACT input observation file names 
     965                           !     coriofiles              Coriolis input observation file name 
     966   !                       ! profbfiles: Profile feedback input observation file name 
    967967   profbfiles = 'profiles_01.nc' 
    968                            !     ln_profb_enatim         Enact feedback input time setting switch     
     968                           !     ln_profb_enatim         Enact feedback input time setting switch 
    969969                           !     slafilesact             Active SLA input observation file name 
    970                            !     slafilespas             Passive SLA input observation file name  
    971    !                       ! slafbfiles: Feedback SLA input observation file name  
     970                           !     slafilespas             Passive SLA input observation file name 
     971   !                       ! slafbfiles: Feedback SLA input observation file name 
    972972   slafbfiles = 'sla_01.nc' 
    973                            !     sstfiles                GHRSST input observation file name        
    974    !                       ! sstfbfiles: Feedback SST input observation file name  
     973                           !     sstfiles                GHRSST input observation file name 
     974   !                       ! sstfbfiles: Feedback SST input observation file name 
    975975   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc' 
    976                            !     seaicefiles             Sea Ice input observation file name  
    977                            !     velavcurfiles           Vel. cur. daily av. input file name   
    978                            !     velhvcurfiles           Vel. cur. high freq. input file name   
    979                            !     velavadcpfiles          Vel. ADCP daily av. input file name     
    980                            !     velhvadcpfiles          Vel. ADCP high freq. input file name  
    981                            !     velfbfiles              Vel. feedback input observation file name  
    982                            !     dobsini                 Initial date in window YYYYMMDD.HHMMSS        
    983                            !     dobsend                 Final date in window YYYYMMDD.HHMMSS          
    984                            !     n1dint                  Type of vertical interpolation method         
    985                            !     n2dint                  Type of horizontal interpolation method        
    986                            !     ln_nea                  Rejection of observations near land switch     
    987    nmsshc     = 0          ! MSSH correction scheme                          
    988                            !     mdtcorr                 MDT  correction                                
    989                            !     mdtcutoff               MDT cutoff for computed correction           
    990    ln_altbias = .false.    ! Logical switch for alt bias                 
    991    ln_ignmis  = .true.     ! Logical switch for ignoring missing files    
    992                            !     endailyavtypes   ENACT daily average types                     
     976                           !     seaicefiles             Sea Ice input observation file name 
     977                           !     velavcurfiles           Vel. cur. daily av. input file name 
     978                           !     velhvcurfiles           Vel. cur. high freq. input file name 
     979                           !     velavadcpfiles          Vel. ADCP daily av. input file name 
     980                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
     981                           !     velfbfiles              Vel. feedback input observation file name 
     982                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS 
     983                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS 
     984                           !     n1dint                  Type of vertical interpolation method 
     985                           !     n2dint                  Type of horizontal interpolation method 
     986                           !     ln_nea                  Rejection of observations near land switch 
     987   nmsshc     = 0          ! MSSH correction scheme 
     988                           !     mdtcorr                 MDT  correction 
     989                           !     mdtcutoff               MDT cutoff for computed correction 
     990   ln_altbias = .false.    ! Logical switch for alt bias 
     991   ln_ignmis  = .true.     ! Logical switch for ignoring missing files 
     992                           !     endailyavtypes   ENACT daily average types 
    993993   ln_grid_global = .true. 
    994994   ln_grid_search_lookup = .false. 
    995 /  
     995/ 
    996996!----------------------------------------------------------------------- 
    997997&nam_asminc   !   assimilation increments                               ('key_asminc') 
    998998!----------------------------------------------------------------------- 
    999     ln_bkgwri = .false.    !  Logical switch for writing out background state  
    1000     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
     999    ln_bkgwri = .false.    !  Logical switch for writing out background state 
    10011000    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    10021001    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    1003     ln_sshinc = .false.    !  Logical switch for applying SSH increments  
     1002    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
    10041003    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI) 
    10051004    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU) 
    … …  
    10091008    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    10101009    niaufn    = 0          !  Type of IAU weighting function 
    1011     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    10121010    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    10131011    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist

    r3567 r3764  
    882882!----------------------------------------------------------------------- 
    883883    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    884     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    885884    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    886885    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    893892    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    894893    niaufn    = 0          !  Type of IAU weighting function 
    895     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    896894    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    897895    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist

    r3657 r3764  
    945945!----------------------------------------------------------------------- 
    946946    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    947     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    948947    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    949948    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    956955    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    957956    niaufn    = 0          !  Type of IAU weighting function 
    958     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    959957    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    960958    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r3688 r3764  
    616616&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    617617!----------------------------------------------------------------------- 
    618    ln_dynvor_ene = .false. !  enstrophy conserving scheme   
    619    ln_dynvor_ens = .false. !  energy conserving scheme     
     618   ln_dynvor_ene = .false. !  energy    conserving scheme   
     619   ln_dynvor_ens = .false. !  enstrophy conserving scheme     
    620620   ln_dynvor_mix = .false. !  mixed scheme                
    621621   ln_dynvor_een = .true.  !  energy & enstrophy scheme   
    … …  
    990990!----------------------------------------------------------------------- 
    991991    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    992     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    993992    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    994993    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    10011000    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    10021001    niaufn    = 0          !  Type of IAU weighting function 
    1003     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    10041002    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    10051003    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/1_namelist

    r3331 r3764  
    895895!----------------------------------------------------------------------- 
    896896    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    897     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    898897    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    899898    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    906905    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    907906    niaufn    = 0          !  Type of IAU weighting function 
    908     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    909907    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    910908    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist

    r3614 r3764  
    994994!----------------------------------------------------------------------- 
    995995    ln_bkgwri = .false.    !  Logical switch for writing out background state  
    996     ln_trjwri = .false.    !  Logical switch for writing out state trajectory 
    997996    ln_trainc = .false.    !  Logical switch for applying tracer increments 
    998997    ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    … …  
    10051004    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    10061005    niaufn    = 0          !  Type of IAU weighting function 
    1007     nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR 
    10081006    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    10091007    salfixmin = -9999      !  Minimum salinity after applying the increments 

  • branches/2012/dev_MERGE_2012/NEMOGCM/CONFIG/makenemo

    r3742 r3764  
    22#set -x 
    33set -o posix 
    4 #set -u  
     4#set -u 
    55#set -e 
    66#+ 
    … …  
    2929# 
    3030# - to choose MYCONFIG 
    31 # - to choose compiler options   
     31# - to choose compiler options 
    3232# - to create the CONFIG/MYCONFIG/WORK directory 
    3333# - to compile this configuration 
    … …  
    3838# 
    3939# - NEW_CONF    : configuration to be created 
    40 # - REF_CONF    : reference configuration to build the new one  
    41 # - CMP_NAM     : compiler name  
    42 # - NBR_PRC     : number of processes used to compile   
     40# - REF_CONF    : reference configuration to build the new one 
     41# - CMP_NAM     : compiler name 
     42# - NBR_PRC     : number of processes used to compile 
    4343# - NEM_SUBDIR  : NEMO subdirectory used (specified) 
    4444# 
    4545#  Locally defined : 
    4646# 
    47 # - TAB         : NEMO subdirectory used (read)   
     47# - TAB         : NEMO subdirectory used (read) 
    4848# - MAIN_DIR    : self explaining 
    49 # - CONFIG_DIR  :   "    "    "    
    50 # - MODELES_DIR :   "    "    "  
    51 # - TOOLS_DIR   :   "    "    "  
     49# - CONFIG_DIR  :   "    "    " 
     50# - MODELES_DIR :   "    "    " 
     51# - TOOLS_DIR   :   "    "    " 
    5252# - NEMO_DIR    :   "    "    " 
    5353# 
    … …  
    134134   echo "makenemo -n MY_CONFIG -d \"OPA_SRC LIM_SRC_2\""; 
    135135   echo ""; 
    136    echo "Available configurations :"; cat ${CONFIG_DIR}/cfg.txt;  
     136   echo "Available configurations :"; cat ${CONFIG_DIR}/cfg.txt; 
    137137   echo ""; 
    138138   echo "Example to remove bad configuration "; 
    … …  
    190190       ;; 
    191191   *) 
    192        echo " \"$1\" BAD OPTION"  
     192       echo " \"$1\" BAD OPTION" 
    193193       exit 
    194194       ;; 
    195     
     195 
    196196    esac 
    197197    shift 
    … …  
    216216#- Check if the tool or the compiler exist or list it 
    217217if [ "${NEW_CONF}" == help ] ; then 
    218     echo "Available configurations :"  
     218    echo "Available configurations :" 
    219219    cat ${CONFIG_DIR}/cfg.txt 
    220220    exit 
    … …  
    228228#- Choose a default configuration if needed --- 
    229229#- ORCA2_LIM or last one used --- 
    230 . ${COMPIL_DIR}/Fcheck_config.sh cfg.txt ${NEW_CONF} || exit  
     230. ${COMPIL_DIR}/Fcheck_config.sh cfg.txt ${NEW_CONF} || exit 
    231231 
    232232 
    … …  
    235235   echo "You are  installing a new configuration" 
    236236   ind=0 
    237    . ${COMPIL_DIR}/Fread_dir.sh OPA_SRC    YES  
    238    . ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_2   YES  
    239    . ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_3   NO   
    240    . ${COMPIL_DIR}/Fread_dir.sh TOP_SRC    NO   
    241    . ${COMPIL_DIR}/Fread_dir.sh NST_SRC    YES  
    242    . ${COMPIL_DIR}/Fread_dir.sh OFF_SRC    NO   
     237   . ${COMPIL_DIR}/Fread_dir.sh OPA_SRC    YES 
     238   . ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_2   YES 
     239   . ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_3   NO 
     240   . ${COMPIL_DIR}/Fread_dir.sh TOP_SRC    NO 
     241   . ${COMPIL_DIR}/Fread_dir.sh NST_SRC    YES 
     242   . ${COMPIL_DIR}/Fread_dir.sh OFF_SRC    NO 
    243243   REF_CONF=ORCA2_LIM 
    244244    elif [ ${#NEM_SUBDIR} -gt 0 ] && [ ${#REF_CONF} -eq 0 ]; then 
    … …  
    248248    elif [ ${#NEM_SUBDIR} -eq 0 ] && [ ${#REF_CONF} -gt 0 ]; then 
    249249   echo "You are  installing a new configuration based on ${REF_CONF}" 
    250    . ${COMPIL_DIR}/Fcopy_dir.sh ${REF_CONF}   
     250   . ${COMPIL_DIR}/Fcopy_dir.sh ${REF_CONF} 
    251251    fi 
    252252    NEW_CONF=${x_n} 
    … …  
    272272#- We add or remove keys 
    273273if [ ${#list_add_key} -ne 0 ] ; then 
    274     . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}  
     274    . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key} 
    275275fi 
    276276 

  • branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm

    r2281 r3764  
    205205 
    206206    for my $i (0 .. $#fields) { 
    207       next if lc ($fields[$i]) eq lc ($all_fields[$i]); 
     207      next if lc ($fields[$i]) eq lc ($all_fields[$i] || ''); 
    208208      $return = 0; 
    209209      last; 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    r2715 r3764  
    3232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tms    , tmu      !: temperature and velocity points masks 
    3333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   wght              !: weight of the 4 neighbours to compute averages 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmv               !: y-velocity mask used for evp rheology  
    3435 
    35  
    36 # if defined key_lim2_vp 
    3736   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   akappa , bkappa   !: first and third group of metric coefficients 
    3837   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) ::   alambd            !: second group of metric coefficients 
    39 # else 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmv    , tmf      !: y-velocity and F-points masks 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmf               !: F-points masks 
    4139   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmi               !: ice mask: =1 if ice thick > 0 
    42 # endif 
    4340   !!---------------------------------------------------------------------- 
    4441   CONTAINS 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r3680 r3764  
    3131   USE agrif_lim2_interp ! nesting 
    3232# endif 
     33   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3334 
    3435   IMPLICIT NONE 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r3625 r3764  
    105105      !! 
    106106      INTEGER  ::   ji, jj, jf                      ! dummy loop indices 
    107       CHARACTER(len = 40)  ::   clhstnam, clop 
     107      CHARACTER(len = 80)  ::   clhstnam, clop 
    108108      REAL(wp) ::   zsto, zjulian, zout,   &  ! temporary scalars 
    109109         &          zindh, zinda, zindb, ztmu 
    … …  
    161161            zcmo(ji,jj,5)  = sist  (ji,jj) 
    162162            zcmo(ji,jj,6)  = fbif  (ji,jj) 
     163           IF (lk_lim2_vp) THEN 
    163164            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    164165                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    … …  
    168169                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    169170                                  / ztmu 
     171           ELSE 
     172 
     173            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj)                       & 
     174             &                        + u_ice(ji-1,jj) * tmu(ji-1,jj) )                   & 
     175             &                    / 2.0 
     176            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)                       & 
     177             &                        + v_ice(ji,jj-1) * tmv(ji,jj-1) )                   & 
     178             &                    / 2.0 
     179 
     180           ENDIF 
    170181            zcmo(ji,jj,9)  = sst_m(ji,jj) 
    171182            zcmo(ji,jj,10) = sss_m(ji,jj) 
    … …  
    187198      niter = niter + 1 
    188199      DO jf = 1 , noumef 
    189          DO jj = 1 , jpj 
    190             DO ji = 1 , jpi 
    191                zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf) 
    192             END DO 
    193          END DO 
    194           
    195          IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN 
     200         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1) 
     201         SELECT CASE ( jf ) 
     202         CASE ( 7, 8, 15, 16, 20, 21 )  ! velocity or stress fields (vectors) 
    196203            CALL lbc_lnk( zfield, 'T', -1. ) 
    197          ELSE  
     204         CASE DEFAULT                   ! scalar fields 
    198205            CALL lbc_lnk( zfield, 'T',  1. ) 
    199          ENDIF 
    200           
     206         END SELECT 
     207 
    201208         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    202           
     209 
    203210      END DO 
    204        
     211 
    205212      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice )  
    206213 
    … …  
    209216   END SUBROUTINE lim_wri_2 
    210217      
    211 # endif 
     218#endif      
    212219 
    213220   SUBROUTINE lim_wri_init_2 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r3625 r3764  
    2020    INTEGER , SAVE ::   nmoyice   !: counter for averaging 
    2121    INTEGER , SAVE ::   nwf       !: number of fields to write on disk 
    22     INTEGER , SAVE, DIMENSION(:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
     22    INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
    2323    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
    2424    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy 
    … …  
    3030    REAL(wp), DIMENSION(1) ::   zdept 
    3131    REAL(wp) ::   zsto, zsec, zjulian,zout 
    32     REAL(wp) ::   zindh,zinda,zindb, ztmu 
    33     REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo   !ARPDBGWORK 
    34     REAL(wp), DIMENSION(jpi,jpj)          ::   zfield 
     32    REAL(wp) ::   zindh, zinda, zindb, ztmu 
     33    REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield 
    3534 
    3635#if ! defined key_diainstant 
    … …  
    4544       IF( lk_mpp      )   CALL mpp_sum ( ialloc  ) 
    4645       IF( ialloc /= 0 )   CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') 
    47        rcmoy(:,:,:) = 0._wp 
    4846    ENDIF 
    4947 
    50     IF( kt == nit000 ) THEN  
     48    CALL wrk_alloc( jpi, jpj, zfield ) 
     49 
     50    IF ( kt == nit000 ) THEN  
    5151       ! 
    5252       CALL lim_wri_init_2  
    … …  
    5555       ii  = 0 
    5656 
    57        IF(lwp ) THEN 
     57       IF (lwp ) THEN 
    5858          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 
    5959          WRITE(numout,*) '~~~~~~~~' 
    … …  
    7979       END DO 
    8080 
     81       rcmoy(:,:,:) = 0.0_wp 
    8182       zsto     = rdt_ice 
    8283       zout     = nwrite * rdt_ice / nn_fsbc 
    … …  
    8990 
    9091#if ! defined key_diainstant  
    91     !-- calculs des valeurs instantanees 
     92    !-- Compute mean values 
    9293 
    9394    zcmo(:,:, 1:jpnoumax ) = 0.e0  
    9495    DO jj = 2 , jpjm1 
    95        DO ji = 2 , jpim1   ! NO vector opt. 
     96       DO ji = 2 , jpim1 
    9697          zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9798          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9899          zindb  = zindh * zinda 
    99           ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
    100100          zcmo(ji,jj,1)  = hsnif (ji,jj) 
    101101          zcmo(ji,jj,2)  = hicif (ji,jj) 
    … …  
    104104          zcmo(ji,jj,5)  = sist  (ji,jj) 
    105105          zcmo(ji,jj,6)  = fbif  (ji,jj) 
    106           zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     106          IF (lk_lim2_vp) THEN 
     107            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
     108            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    107109             &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    108110               / ztmu  
    109111 
    110           zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     112            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    111113             &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    112114               / ztmu 
     115           ELSE 
     116            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 
     117            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 
     118           ENDIF 
     119 
    113120          zcmo(ji,jj,9)  = sst_m(ji,jj) 
    114121          zcmo(ji,jj,10) = sss_m(ji,jj) 
    … …  
    136143          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 
    137144          DO jj = 2 , jpjm1 
    138              DO ji = 2 , jpim1   ! NO vector opt. 
     145             DO ji = 2 , jpim1 
    139146                zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    140147                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    141148                zindb  = zindh * zinda 
    142                 ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
    143149                rcmoy(ji,jj,1)  = hsnif (ji,jj) 
    144150                rcmoy(ji,jj,2)  = hicif (ji,jj) 
    … …  
    147153                rcmoy(ji,jj,5)  = sist  (ji,jj) 
    148154                rcmoy(ji,jj,6)  = fbif  (ji,jj) 
    149                 rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    150                    &                       + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    151                      / ztmu 
    152  
    153                 rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    154                    &                       + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    155                      / ztmu 
     155                IF (lk_lim2_vp) THEN 
     156                   ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
     157                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     158                      &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     159                        / ztmu 
     160 
     161                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     162                      &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     163                       / ztmu 
     164                ELSE 
     165                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 
     166                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 
     167                ENDIF 
    156168                rcmoy(ji,jj,9)  = sst_m(ji,jj) 
    157169                rcmoy(ji,jj,10) = sss_m(ji,jj) 
    … …  
    176188             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 
    177189 
    178              IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
     190             SELECT CASE (jf)  
     191             CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors) 
    179192                CALL lbc_lnk( zfield, 'T', -1. ) 
    180              ELSE  
     193             CASE DEFAULT          ! scalar fields 
    181194                CALL lbc_lnk( zfield, 'T',  1. ) 
    182              ENDIF 
     195             END SELECT 
    183196             rcmoy(:,:,jf) = zfield(:,:) 
    184197          END DO 
    … …  
    200213          nmoyice = 0  
    201214       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! 
     215       CALL wrk_dealloc( jpi,jpj, zfield ) 
    202216 
    203217     END SUBROUTINE lim_wri_2 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r3625 r3764  
    2424   USE wrk_nemo       ! work arrays 
    2525   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     26   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    2627 
    2728   IMPLICIT NONE 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r3625 r3764  
    2929   USE prtctl         ! Print control 
    3030   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     31   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3132 
    3233   IMPLICIT NONE 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r3625 r3764  
    3434   USE wrk_nemo       ! work arrays 
    3535   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     36   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3637 
    3738   IMPLICIT NONE 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90

    r3625 r3764  
    1515   !!------------------------------------------------------------------- 
    1616   USE  diawri, ONLY : dia_wri_dimg 
     17   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     18 
    1719   REAL(wp),DIMENSION(1) ::   zdept 
    1820 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r3750 r3764  
    4545   USE prtctl          ! Print control                    (prt_ctl_init routine) 
    4646   USE timing          ! Timing 
     47   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    4748 
    4849   IMPLICIT NONE 
    … …  
    342343         &                                               'Compile with key_iomput enabled' ) 
    343344      ! 
     345      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
     346         &                                               'f2003 standard. '                              ,  & 
     347         &                                               'Compile with key_nosignedzero enabled' ) 
     348      ! 
    344349   END SUBROUTINE nemo_ctl 
    345350 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r3294 r3764  
    1010   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2 
    1111   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
     12   !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization 
    1213   !!---------------------------------------------------------------------- 
    1314 
    … …  
    2021   !!   dyn_asm_inc  : Apply the dynamic (u and v) increments 
    2122   !!   ssh_asm_inc  : Apply the SSH increment 
     23   !!   seaice_asm_inc  : Apply the seaice increment 
    2224   !!---------------------------------------------------------------------- 
    2325   USE wrk_nemo         ! Memory Allocation 
    … …  
    2527   USE dom_oce          ! Ocean space and time domain 
    2628   USE oce              ! Dynamics and active tracers defined in memory 
    27    USE divcur           ! Horizontal divergence and relative vorticity 
    2829   USE ldfdyn_oce       ! ocean dynamics: lateral physics 
    2930   USE eosbn2           ! Equation of state - in situ and potential density 
    … …  
    3334   USE c1d              ! 1D initialization 
    3435   USE in_out_manager   ! I/O manager 
    35    USE lib_mpp           ! MPP library 
     36   USE lib_mpp          ! MPP library 
     37#if defined key_lim3 
     38   USE ice              ! LIM3 
     39#endif 
     40#if defined key_lim2 
     41   USE ice_2            ! LIM2 
     42#endif 
     43   USE sbc_oce          ! Surface boundary condition variables. 
     44   USE domvvl 
    3645 
    3746   IMPLICIT NONE 
    … …  
    4352   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
    4453   PUBLIC   ssh_asm_inc    !: Apply the SSH increment 
     54   PUBLIC   seaice_asm_inc !: Apply the seaice increment 
    4555 
    4656#if defined key_asminc 
    … …  
    5060#endif 
    5161   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields 
    52    LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields 
    5362   LOGICAL, PUBLIC :: ln_asmiau = .FALSE. !: No applying forcing with an assimilation increment 
    5463   LOGICAL, PUBLIC :: ln_asmdin = .FALSE. !: No direct initialization 
    … …  
    5665   LOGICAL, PUBLIC :: ln_dyninc = .FALSE. !: No dynamics (u and v) assimilation increments 
    5766   LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment 
     67   LOGICAL, PUBLIC :: ln_seaiceinc = .FALSE. !: No sea ice concentration increment 
    5868   LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 
     69   LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing 
    5970   INTEGER, PUBLIC :: nn_divdmp = 0       !: Apply divergence damping filter nn_divdmp times 
    6071 
    … …  
    7889 
    7990   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment 
     91   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   seaice_bkginc         ! Increment to the background sea ice conc 
    8092 
    8193   !! * Substitutions 
    … …  
    125137      REAL(wp), POINTER, DIMENSION(:,:) :: hdiv 
    126138      !! 
    127       NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri,                           & 
     139      NAMELIST/nam_asminc/ ln_bkgwri,                                      & 
    128140         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
    129141         &                 ln_asmdin, ln_asmiau,                           & 
    130142         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    131          &                 nittrjfrq, ln_salfix, salfixmin,                & 
     143         &                 ln_salfix, salfixmin,                & 
    132144         &                 nn_divdmp 
    133145      !!---------------------------------------------------------------------- 
    … …  
    139151      ! Set default values 
    140152      ln_bkgwri = .FALSE. 
    141       ln_trjwri = .FALSE. 
    142153      ln_trainc = .FALSE. 
    143154      ln_dyninc = .FALSE. 
    144155      ln_sshinc = .FALSE. 
     156      ln_seaiceinc = .FALSE. 
    145157      ln_asmdin = .FALSE. 
    146158      ln_asmiau = .TRUE. 
    147159      ln_salfix = .FALSE. 
     160      ln_temnofreeze = .FALSE. 
    148161      salfixmin = -9999 
    149162      nitbkg    = 0 
    … …  
    152165      nitiaufin = 150      ! = 10 days with ORCA2 
    153166      niaufn    = 0 
    154       nittrjfrq = 1 
    155167 
    156168      REWIND ( numnam ) 
    … …  
    164176         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
    165177         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri 
    166          WRITE(numout,*) '      Logical switch for writing out state trajectory          ln_trjwri = ', ln_trjwri 
    167178         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
    168179         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
    169180         WRITE(numout,*) '      Logical switch for applying SSH increments               ln_sshinc = ', ln_sshinc 
    170181         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin 
     182         WRITE(numout,*) '      Logical switch for applying sea ice increments        ln_seaiceinc = ', ln_seaiceinc 
    171183         WRITE(numout,*) '      Logical switch for Incremental Analysis Updating (IAU)   ln_asmiau = ', ln_asmiau 
    172184         WRITE(numout,*) '      Timestep of background in [0,nitend-nit000-1]            nitbkg    = ', nitbkg 
    … …  
    175187         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin 
    176188         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn 
    177          WRITE(numout,*) '      Frequency of trajectory output for 4D-VAR                nittrjfrq = ', nittrjfrq 
    178189         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix 
    179190         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin 
    … …  
    213224         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r 
    214225         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r 
    215          WRITE(numout,*) '       nittrjfrq   = ', nittrjfrq 
    216226         WRITE(numout,*) 
    217227         WRITE(numout,*) '   Dates referenced to current cycle:' 
    … …  
    235245 
    236246      IF (      ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) & 
    237            .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) ) & 
    238          & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc and ln_sshinc is set to .true.', & 
     247           .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) .OR. ( ln_seaiceinc) )) & 
     248         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc is set to .true.', & 
    239249         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', & 
    240250         &                ' Inconsistent options') 
    … …  
    248258         &                ' Type IAU weighting function is invalid') 
    249259 
    250       IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ) & 
     260      IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ).AND.( .NOT. ln_seaiceinc ) & 
    251261         &                     )  & 
    252          & CALL ctl_warn( ' ln_trainc, ln_dyninc and ln_sshinc are set to .false. :', & 
     262         & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc are set to .false. :', & 
    253263         &                ' The assimilation increments are not applied') 
    254264 
    … …  
    353363      ALLOCATE( v_bkginc(jpi,jpj,jpk) ) 
    354364      ALLOCATE( ssh_bkginc(jpi,jpj)   ) 
     365      ALLOCATE( seaice_bkginc(jpi,jpj)) 
    355366#if defined key_asminc 
    356367      ALLOCATE( ssh_iau(jpi,jpj)      ) 
    … …  
    361372      v_bkginc(:,:,:) = 0.0 
    362373      ssh_bkginc(:,:) = 0.0 
     374      seaice_bkginc(:,:) = 0.0 
    363375#if defined key_asminc 
    364376      ssh_iau(:,:)    = 0.0 
    365377#endif 
    366       IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) THEN 
     378      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN 
    367379 
    368380         !-------------------------------------------------------------------- 
    … …  
    429441         ENDIF 
    430442 
     443         IF ( ln_seaiceinc ) THEN 
     444            CALL iom_get( inum, jpdom_autoglo, 'bckinseaice', seaice_bkginc, 1 ) 
     445            ! Apply the masks 
     446            seaice_bkginc(:,:) = seaice_bkginc(:,:) * tmask(:,:,1) 
     447            ! Set missing increments to 0.0 rather than 1e+20 
     448            ! to allow for differences in masks 
     449            WHERE( ABS( seaice_bkginc(:,:) ) > 1.0e+10 ) seaice_bkginc(:,:) = 0.0 
     450         ENDIF 
     451 
    431452         CALL iom_close( inum ) 
    432453  
    … …  
    437458      !----------------------------------------------------------------------- 
    438459 
    439  
    440460      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 
    441461 
    442       CALL wrk_alloc(jpi,jpj,hdiv)  
    443  
    444        DO  jt = 1, nn_divdmp 
    445  
    446            DO jk = 1, jpkm1 
    447  
    448                   hdiv(:,:) = 0._wp 
    449  
    450             DO jj = 2, jpjm1 
    451                DO ji = fs_2, fs_jpim1   ! vector opt. 
    452                   hdiv(ji,jj) =   & 
    453                      (  e2u(ji  ,jj)*fse3u(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)       & 
    454                       - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)       & 
    455                       + e1v(ji,jj  )*fse3v(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)       & 
    456                       - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  )    & 
    457                       / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     462         CALL wrk_alloc(jpi,jpj,hdiv)  
     463 
     464         DO  jt = 1, nn_divdmp 
     465 
     466            DO jk = 1, jpkm1 
     467 
     468               hdiv(:,:) = 0._wp 
     469 
     470               DO jj = 2, jpjm1 
     471                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     472                     hdiv(ji,jj) =   & 
     473                        (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * u_bkginc(ji  ,jj  ,jk)     & 
     474                         - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * u_bkginc(ji-1,jj  ,jk)     & 
     475                         + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     & 
     476                         - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  & 
     477                         / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     478                  END DO 
    458479               END DO 
     480 
     481               CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change) 
     482 
     483               DO jj = 2, jpjm1 
     484                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     485                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
     486                                                                        - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
     487                                                                      / e1u(ji,jj) * umask(ji,jj,jk)  
     488                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
     489                                                                        - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
     490                                                                      / e2v(ji,jj) * vmask(ji,jj,jk)  
     491                  END DO 
     492               END DO 
     493 
    459494            END DO 
    460495 
    461             CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change) 
    462  
    463             DO jj = 2, jpjm1 
    464                DO ji = fs_2, fs_jpim1   ! vector opt. 
    465                   u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
    466                                                                   - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
    467                                                                 / e1u(ji,jj) * umask(ji,jj,jk)  
    468                   v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
    469                                                                   - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
    470                                                                 / e2v(ji,jj) * vmask(ji,jj,jk)  
    471                END DO 
    472             END DO 
    473  
    474            END DO 
    475  
    476        END DO 
    477  
    478        CALL wrk_dealloc(jpi,jpj,hdiv)  
     496         END DO 
     497 
     498         CALL wrk_dealloc(jpi,jpj,hdiv)  
    479499 
    480500      ENDIF 
    … …  
    506526         CALL iom_open( c_asmdin, inum ) 
    507527 
    508          CALL iom_get( inum, 'zdate', zdate_bkg )  
     528         CALL iom_get( inum, 'rdastp', zdate_bkg )  
    509529         
    510530         IF(lwp) THEN 
    … …  
    662682      INTEGER :: it 
    663683      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    664       !!---------------------------------------------------------------------- 
     684      REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values 
     685      !!---------------------------------------------------------------------- 
     686 
     687      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths)  
     688      ! used to prevent the applied increments taking the temperature below the local freezing point  
     689 
     690#if defined key_cice  
     691        fzptnz(:,:,:) = -1.8_wp 
     692#else  
     693        DO jk = 1, jpk 
     694           DO jj = 1, jpj 
     695              DO ji = 1, jpk 
     696                 fzptnz (ji,jj,jk) = ( -0.0575_wp + 1.710523e-3_wp * SQRT( tsn(ji,jj,jk,jp_sal) )                   &  
     697                                                  - 2.154996e-4_wp *       tsn(ji,jj,jk,jp_sal)   ) * tsn(ji,jj,jk,jp_sal)  &  
     698                                                  - 7.53e-4_wp * fsdepw(ji,jj,jk)       ! (pressure in dbar)  
     699              END DO 
     700           END DO 
     701        END DO 
     702#endif  
    665703 
    666704      IF ( ln_asmiau ) THEN 
    … …  
    684722            ! Update the tracer tendencies 
    685723            DO jk = 1, jpkm1 
    686                tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt   
    687                tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt 
     724               IF (ln_temnofreeze) THEN 
     725                  ! Do not apply negative increments if the temperature will fall below freezing 
     726                  WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. & 
     727                     &   tsn(:,:,jk,jp_tem) + tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )  
     728                     tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt   
     729                  END WHERE 
     730               ELSE 
     731                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt   
     732               ENDIF 
     733               IF (ln_salfix) THEN 
     734                  ! Do not apply negative increments if the salinity will fall below a specified 
     735                  ! minimum value salfixmin 
     736                  WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. & 
     737                     &   tsn(:,:,jk,jp_sal) + tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )  
     738                     tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt 
     739                  END WHERE 
     740               ELSE 
     741                  tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt 
     742               ENDIF 
    688743            END DO 
    689  
    690             ! Salinity fix 
    691             IF (ln_salfix) THEN 
    692                DO jk = 1, jpkm1 
    693                   DO jj = 1, jpj 
    694                      DO ji= 1, jpi 
    695                         tsa(ji,jj,jk,jp_sal) = MAX( tsa(ji,jj,jk,jp_sal), salfixmin ) 
    696                      END DO 
    697                   END DO 
    698                END DO 
    699             ENDIF 
    700744 
    701745         ENDIF 
    … …  
    718762 
    719763            ! Initialize the now fields with the background + increment 
    720             tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
    721             tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
    722  
    723             ! Optional salinity fix 
     764            IF (ln_temnofreeze) THEN 
     765               ! Do not apply negative increments if the temperature will fall below freezing 
     766               WHERE(t_bkginc(:,:,:) > 0.0_wp .OR. & 
     767                  &   tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
     768                  tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     769               END WHERE 
     770            ELSE 
     771               tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     772            ENDIF 
    724773            IF (ln_salfix) THEN 
    725                DO jk = 1, jpkm1 
    726                   DO jj = 1, jpj 
    727                      DO ji= 1, jpi 
    728                         tsn(ji,jj,jk,jp_sal) = MAX( tsn(ji,jj,jk,jp_sal), salfixmin ) 
    729                      END DO 
    730                   END DO 
    731                END DO 
     774               ! Do not apply negative increments if the salinity will fall below a specified 
     775               ! minimum value salfixmin 
     776               WHERE(s_bkginc(:,:,:) > 0.0_wp .OR. & 
     777                  &   tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin )  
     778                  tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
     779               END WHERE 
     780            ELSE 
     781               tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
    732782            ENDIF 
    733783 
    734             tsb(:,:,:,:) = tsn(:,:,:,:)                        ! Update before fields 
     784            tsb(:,:,:,:) = tsn(:,:,:,:)               ! Update before fields 
    735785 
    736786            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities 
    737787          
    738788            IF( ln_zps .AND. .NOT. lk_c1d ) & 
    739                &  CALL zps_hde( nit000, jpts, tsb,   &  ! Partial steps: before horizontal derivative 
    740                &                gtsu, gtsv, rhd,        &  ! of T, S, rd at the bottom ocean level 
     789               &  CALL zps_hde( nit000, jpts, tsb, &  ! Partial steps: before horizontal derivative 
     790               &                gtsu, gtsv, rhd,   &  ! of T, S, rd at the bottom ocean level 
    741791               &                gru , grv ) 
     792 
     793#if defined key_zdfkpp 
     794            CALL eos( tsn, rhd )                      ! Compute rhd 
     795#endif 
    742796 
    743797            DEALLOCATE( t_bkginc ) 
    … …  
    748802         !   
    749803      ENDIF 
     804      ! Perhaps the following call should be in step 
     805      IF   ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment 
    750806      ! 
    751807   END SUBROUTINE tra_asm_inc 
    … …  
    817873            vb(:,:,:) = vn(:,:,:) 
    818874  
    819             CALL div_cur( kt )            ! Compute divergence and curl for now fields 
    820  
    821             rotb (:,:,:) = rotn (:,:,:)   ! Update before fields 
    822             hdivb(:,:,:) = hdivn(:,:,:) 
    823  
    824875            DEALLOCATE( u_bkg    ) 
    825876            DEALLOCATE( v_bkg    ) 
    … …  
    846897      ! 
    847898      INTEGER :: it 
     899      INTEGER :: jk 
    848900      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    849901      !!---------------------------------------------------------------------- 
    … …  
    891943            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   
    892944 
    893             sshb(:,:) = sshn(:,:)         ! Update before fields 
     945            ! Update before fields 
     946            sshb(:,:) = sshn(:,:)          
     947 
     948            IF( lk_vvl ) THEN 
     949               DO jk = 1, jpk 
     950                  fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     951               END DO 
     952            ENDIF 
    894953 
    895954            DEALLOCATE( ssh_bkg    ) 
    … …  
    902961   END SUBROUTINE ssh_asm_inc 
    903962 
     963   SUBROUTINE seaice_asm_inc( kt, kindic ) 
     964      !!---------------------------------------------------------------------- 
     965      !!                    ***  ROUTINE seaice_asm_inc  *** 
     966      !!           
     967      !! ** Purpose : Apply the sea ice assimilation increment. 
     968      !! 
     969      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
     970      !! 
     971      !! ** Action  :  
     972      !! 
     973      !! History : 
     974      !!        !  07-2011  (D. Lea)  Initial version based on ssh_asm_inc 
     975      !!---------------------------------------------------------------------- 
     976 
     977      IMPLICIT NONE 
     978 
     979      !! * Arguments 
     980      INTEGER, INTENT(IN) :: kt   ! Current time step 
     981      INTEGER, OPTIONAL, INTENT(IN) :: kindic ! flag for disabling the deallocation 
     982 
     983      !! * Local declarations 
     984      INTEGER :: it 
     985      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     986 
     987#if defined key_lim3 || defined key_lim2 
     988      REAL(wp), DIMENSION(jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc  ! LIM 
     989      REAL(wp) :: zhicifmin=0.5_wp      ! ice minimum depth in metres 
     990 
     991#endif 
     992 
     993 
     994      IF ( ln_asmiau ) THEN 
     995 
     996         !-------------------------------------------------------------------- 
     997         ! Incremental Analysis Updating 
     998         !-------------------------------------------------------------------- 
     999 
     1000         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 
     1001 
     1002            it = kt - nit000 + 1 
     1003            zincwgt = wgtiau(it)      ! IAU weight for the current time step  
     1004            ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 
     1005 
     1006            IF(lwp) THEN 
     1007               WRITE(numout,*)  
     1008               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', & 
     1009                  &  kt,' with IAU weight = ', wgtiau(it) 
     1010               WRITE(numout,*) '~~~~~~~~~~~~' 
     1011            ENDIF 
     1012 
     1013#if defined key_lim3 || defined key_lim2 
     1014 
     1015            zofrld(:,:)=frld(:,:) 
     1016            zohicif(:,:)=hicif(:,:) 
     1017 
     1018            frld = MIN( MAX( frld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     1019            pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     1020            fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction 
     1021 
     1022            zseaicendg(:,:)=zofrld(:,:) - frld(:,:)         ! find out actual sea ice nudge applied 
     1023 
     1024            ! Nudge sea ice depth to bring it up to a required minimum depth 
     1025 
     1026            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
     1027               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     1028            ELSEWHERE 
     1029               zhicifinc(:,:) = 0.0_wp 
     1030            END WHERE 
     1031 
     1032! nudge ice depth 
     1033            hicif(:,:)=hicif(:,:) + zhicifinc(:,:) 
     1034            phicif(:,:)=phicif(:,:) + zhicifinc(:,:)        
     1035 
     1036! seaice salinity balancing (to add) 
     1037 
     1038#endif 
     1039 
     1040#if defined key_cice 
     1041 
     1042! Pass ice increment tendency into CICE 
     1043            ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt 
     1044 
     1045#endif 
     1046 
     1047            IF ( kt == nitiaufin_r ) THEN 
     1048               DEALLOCATE( seaice_bkginc ) 
     1049            ENDIF 
     1050 
     1051         ELSE 
     1052 
     1053#if defined key_cice 
     1054 
     1055! Zero ice increment tendency into CICE 
     1056            ndaice_da(:,:) = 0.0_wp 
     1057 
     1058#endif 
     1059 
     1060         ENDIF 
     1061 
     1062      ELSEIF ( ln_asmdin ) THEN 
     1063 
     1064         !-------------------------------------------------------------------- 
     1065         ! Direct Initialization 
     1066         !-------------------------------------------------------------------- 
     1067 
     1068         IF ( kt == nitdin_r ) THEN 
     1069 
     1070            neuler = 0                    ! Force Euler forward step 
     1071 
     1072#if defined key_lim3 || defined key_lim2 
     1073 
     1074            zofrld(:,:)=frld(:,:) 
     1075            zohicif(:,:)=hicif(:,:) 
     1076  
     1077            ! Initialize the now fields the background + increment 
     1078 
     1079            frld(:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
     1080            pfrld(:,:) = frld(:,:)  
     1081            fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction 
     1082 
     1083            zseaicendg(:,:)=zofrld(:,:) - frld(:,:)         ! find out actual sea ice nudge applied 
     1084 
     1085            ! Nudge sea ice depth to bring it up to a required minimum depth 
     1086 
     1087            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
     1088               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     1089            ELSEWHERE 
     1090               zhicifinc(:,:) = 0.0_wp 
     1091            END WHERE 
     1092 
     1093! nudge ice depth 
     1094            hicif(:,:)=hicif(:,:) + zhicifinc(:,:) 
     1095            phicif(:,:)=phicif(:,:)        
     1096 
     1097! seaice salinity balancing (to add) 
     1098   
     1099#endif 
     1100  
     1101#if defined key_cice 
     1102 
     1103! Pass ice increment tendency into CICE - is this correct? 
     1104           ndaice_da(:,:) = seaice_bkginc(:,:) / rdt 
     1105 
     1106#endif 
     1107           IF ( .NOT. PRESENT(kindic) ) THEN 
     1108              DEALLOCATE( seaice_bkginc ) 
     1109           END IF 
     1110 
     1111         ELSE 
     1112 
     1113#if defined key_cice 
     1114 
     1115! Zero ice increment tendency into CICE  
     1116            ndaice_da(:,:) = 0.0_wp 
     1117 
     1118#endif 
     1119          
     1120         ENDIF 
     1121 
     1122!#if defined key_lim3 || defined key_lim2 || defined key_cice 
     1123! 
     1124!            IF (ln_seaicebal ) THEN        
     1125!             !! balancing salinity increments 
     1126!             !! simple case from limflx.F90 (doesn't include a mass flux) 
     1127!             !! assumption is that as ice concentration is reduced or increased 
     1128!             !! the snow and ice depths remain constant 
     1129!             !! note that snow is being created where ice concentration is being increased 
     1130!             !! - could be more sophisticated and 
     1131!             !! not do this (but would need to alter h_snow) 
     1132! 
     1133!             usave(:,:,:)=sb(:,:,:)   ! use array as a temporary store 
     1134! 
     1135!             DO jj = 1, jpj 
     1136!               DO ji = 1, jpi  
     1137!           ! calculate change in ice and snow mass per unit area 
     1138!           ! positive values imply adding salt to the ocean (results from ice formation) 
     1139!           ! fwf : ice formation and melting 
     1140! 
     1141!                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rdt 
     1142! 
     1143!           ! change salinity down to mixed layer depth 
     1144!                 mld=hmld_kara(ji,jj) 
     1145! 
     1146!           ! prevent small mld 
     1147!           ! less than 10m can cause salinity instability  
     1148!                 IF (mld < 10) mld=10 
     1149! 
     1150!           ! set to bottom of a level  
     1151!                 DO jk = jpk-1, 2, -1 
     1152!                   IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN  
     1153!                     mld=gdepw(ji,jj,jk+1) 
     1154!                     jkmax=jk 
     1155!                   ENDIF 
     1156!                 ENDDO 
     1157! 
     1158!            ! avoid applying salinity balancing in shallow water or on land 
     1159!            !  
     1160! 
     1161!            ! dsal_ocn (psu kg m^-2) / (kg m^-3 * m) 
     1162! 
     1163!                 dsal_ocn=0.0_wp 
     1164!                 sal_thresh=5.0_wp        ! minimum salinity threshold for salinity balancing 
     1165! 
     1166!                 if (tmask(ji,jj,1) > 0 .AND. tmask(ji,jj,jkmax) > 0 ) & 
     1167!                              dsal_ocn = zfons / (rhop(ji,jj,1) * mld) 
     1168! 
     1169!           ! put increments in for levels in the mixed layer 
     1170!           ! but prevent salinity below a threshold value  
     1171! 
     1172!                   DO jk = 1, jkmax               
     1173! 
     1174!                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN  
     1175!                           sb(ji,jj,jk) = sb(ji,jj,jk) + dsal_ocn 
     1176!                           sn(ji,jj,jk) = sn(ji,jj,jk) + dsal_ocn 
     1177!                     ENDIF 
     1178! 
     1179!                   ENDDO 
     1180! 
     1181!      !            !  salt exchanges at the ice/ocean interface 
     1182!      !            zpmess         = zfons / rdt_ice    ! rdt_ice is ice timestep 
     1183!      ! 
     1184!      !! Adjust fsalt. A +ve fsalt means adding salt to ocean 
     1185!      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt   
     1186!      !!                
     1187!      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d)  
     1188!      !!                                                     ! E-P (kg m-2 s-2) 
     1189!      !            emp(ji,jj) = emp(ji,jj) + zpmess          ! E-P (kg m-2 s-2) 
     1190!               ENDDO !ji 
     1191!             ENDDO !jj! 
     1192! 
     1193!            ENDIF !ln_seaicebal 
     1194! 
     1195!#endif 
     1196 
     1197 
     1198      ENDIF 
     1199 
     1200   END SUBROUTINE seaice_asm_inc 
    9041201   !!====================================================================== 
    9051202END MODULE asminc 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r3294 r3764  
    313313      ! surface boundary condition 
    314314      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                    
    315       ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,jk,jp_tem) * sshn(:,:) * tmask(:,:,jk)    
     315      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)    
    316316      ENDIF 
    317317      ! integration down to ilevel 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r3610 r3764  
    455455      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 
    456456      !!---------------------------------------------------------------------- 
    457       IF( nn_timing == 1 )   CALL timing_start('dia_ptr_init') 
    458457 
    459458      REWIND( numnam )                 ! Read Namelist namptr : poleward transport parameters 
    … …  
    474473       
    475474      IF( ln_diaptr) THEN   
     475      
     476         IF( nn_timing == 1 )   CALL timing_start('dia_ptr_init') 
    476477       
    477478         IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
    … …  
    528529         nidom_ptr = FLIO_DOM_NONE 
    529530#endif 
     531      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init') 
     532      ! 
    530533      ENDIF  
    531       !  
    532       IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init') 
    533534      !  
    534535   END SUBROUTINE dia_ptr_init 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r3625 r3764  
    165165       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)  
    166166       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:) 
    167        fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) 
    168        fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) 
     167       IF( ln_ssr ) THEN 
     168          IF( nn_sstr /= 0 )   fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) 
     169          IF( nn_sssr /= 0 )   fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) 
     170       ENDIF 
    169171       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:) 
    170172       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:) 
    … …  
    234236          fsel(:,:,6 ) = sshn(:,:) 
    235237          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1) 
    236           fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1) 
    237           fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1) 
     238          IF( ln_ssr ) THEN 
     239             IF( nn_sstr /= 0 )   fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1) 
     240             IF( nn_sssr /= 0 )   fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1) 
     241          ENDIF 
    238242          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1) 
    239243          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1) 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r3680 r3764  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  daymod  *** 
    4    !! Ocean        :  calendar  
     4   !! Ocean        :  calendar 
    55   !!===================================================================== 
    66   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code 
    77   !!                 ! 1997-03  (O. Marti) 
    8    !!                 ! 1997-05  (G. Madec)  
     8   !!                 ! 1997-05  (G. Madec) 
    99   !!                 ! 1997-08  (M. Imbard) 
    1010   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday 
    1111   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj 
    1212   !!                 ! 2006-08  (G. Madec)  surface module major update 
    13    !!----------------------------------------------------------------------       
     13   !!---------------------------------------------------------------------- 
    1414 
    1515   !!---------------------------------------------------------------------- 
    1616   !!   day        : calendar 
    17    !!   
     17   !! 
    1818   !!           ------------------------------- 
    1919   !!           ----------- WARNING ----------- 
    … …  
    2424   !!           ----------- WARNING ----------- 
    2525   !!           ------------------------------- 
    26    !!   
     26   !! 
    2727   !!---------------------------------------------------------------------- 
    2828   USE dom_oce         ! ocean space and time domain 
    2929   USE phycst          ! physical constants 
    3030   USE in_out_manager  ! I/O manager 
    31    USE iom             !  
     31   USE iom             ! 
    3232   USE ioipsl, ONLY :   ymds2ju   ! for calendar 
    3333   USE prtctl          ! Print control 
    … …  
    4141   PUBLIC   day        ! called by step.F90 
    4242   PUBLIC   day_init   ! called by istate.F90 
    43  
    44    INTEGER ::   nsecd, nsecd05, ndt, ndt05 
     43   PUBLIC   day_mth    ! Needed by TAM 
     44 
     45   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05 ! (PUBLIC for TAM) 
    4546 
    4647   !!---------------------------------------------------------------------- 
    … …  
    5455      !!---------------------------------------------------------------------- 
    5556      !!                   ***  ROUTINE day_init  *** 
    56       !!  
    57       !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000  
     57      !! 
     58      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000 
    5859      !!                because day will be called at the beginning of step 
    5960      !! 
    … …  
    8182      ndt05   = NINT(0.5 * rdttra(1)) 
    8283 
    83       IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' )  
     84      IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 
    8485 
    8586      ! set the calandar from ndastp (read in restart file and namelist) 
    … …  
    8788      nyear   =   ndastp / 10000 
    8889      nmonth  = ( ndastp - (nyear * 10000) ) / 100 
    89       nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )  
     90      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
    9091 
    9192      CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00 
    … …  
    9596      nsec1jan000 = 0 
    9697      CALL day_mth 
    97        
     98 
    9899      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1 
    99          nmonth = nmonth - 1   
     100         nmonth = nmonth - 1 
    100101         nday = nmonth_len(nmonth) 
    101102      ENDIF 
    … …  
    106107         IF( nleapy == 1 )   CALL day_mth 
    107108      ENDIF 
    108        
     109 
    109110      ! day since january 1st 
    110111      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 
    111112 
    112       !compute number of days between last monday and today       
     113      !compute number of days between last monday and today 
    113114      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
    114       inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day   
    115       idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day   
     115      inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day 
     116      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day 
    116117 
    117118      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 
    … …  
    135136      !!---------------------------------------------------------------------- 
    136137      !!                   ***  ROUTINE day_init  *** 
    137       !!  
     138      !! 
    138139      !! ** Purpose :   calendar values related to the months 
    139140      !! 
    … …  
    147148 
    148149      ! length of the month of the current year (from nleapy, read in namelist) 
    149       IF ( nleapy < 2 ) THEN  
     150      IF ( nleapy < 2 ) THEN 
    150151         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /) 
    151152         nyear_len(:) = 365 
    … …  
    167168      ! time since Jan 1st   0     1     2    ...    11    12    13 
    168169      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 
    169       !                 <---> <---> <--->  ...  <---> <---> <--->         
     170      !                 <---> <---> <--->  ...  <---> <---> <---> 
    170171      ! month number      0     1     2    ...    11    12    13 
    171172      ! 
    … …  
    180181         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 
    181182      END DO 
    182       !            
    183    END SUBROUTINE  
     183      ! 
     184   END SUBROUTINE 
    184185 
    185186 
    … …  
    187188      !!---------------------------------------------------------------------- 
    188189      !!                      ***  ROUTINE day  *** 
    189       !!  
     190      !! 
    190191      !! ** Purpose :   Compute the date with a day iteration IF necessary. 
    191192      !! 
    … …  
    199200      !!              - adatrj    : date in days since the beginning of the run 
    200201      !!              - nsec_year : current time of the year (in second since 00h, jan 1st) 
    201       !!----------------------------------------------------------------------       
     202      !!---------------------------------------------------------------------- 
    202203      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices 
    203204      ! 
    … …  
    210211      zprec = 0.1 / rday 
    211212      !                                                 ! New time-step 
    212       nsec_year  = nsec_year  + ndt  
    213       nsec_month = nsec_month + ndt                  
     213      nsec_year  = nsec_year  + ndt 
     214      nsec_month = nsec_month + ndt 
    214215      nsec_week  = nsec_week  + ndt 
    215       nsec_day   = nsec_day   + ndt                 
     216      nsec_day   = nsec_day   + ndt 
    216217      adatrj  = adatrj  + rdttra(1) / rday 
    217218      fjulday = fjulday + rdttra(1) / rday 
    218219      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    219220      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error 
    220        
     221 
    221222      IF( nsec_day > nsecd ) THEN                       ! New day 
    222223         ! 
    … …  
    251252 
    252253      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week 
    253        
     254 
    254255      IF(ln_ctl) THEN 
    255256         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    … …  
    268269      !!--------------------------------------------------------------------- 
    269270      !!                   ***  ROUTINE ts_rst  *** 
    270       !!  
     271      !! 
    271272      !!  ** Purpose : Read or write calendar in restart file: 
    272       !!  
     273      !! 
    273274      !!  WRITE(READ) mode: 
    274       !!       kt        : number of time step since the begining of the experiment at the  
     275      !!       kt        : number of time step since the begining of the experiment at the 
    275276      !!                   end of the current(previous) run 
    276       !!       adatrj(0) : number of elapsed days since the begining of the experiment at the  
     277      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the 
    277278      !!                   end of the current(previous) run (REAL -> keep fractions of day) 
    278279      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer) 
    279       !!  
     280      !! 
    280281      !!   According to namelist parameter nrstdt, 
    281282      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary). 
    … …  
    295296      REAL(wp) ::   zkt, zndastp 
    296297      !!---------------------------------------------------------------------- 
    297        
     298 
    298299      IF( TRIM(cdrw) == 'READ' ) THEN 
    299300 
    … …  
    312313               WRITE(numout,*) 
    313314            ENDIF 
    314             ! Control of date  
    315             IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &  
    316                  &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &  
     315            ! Control of date 
     316            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         & 
     317                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
    317318                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
    318319            ! define ndastp and adatrj 
    319             IF ( nrstdt == 2 ) THEN  
     320            IF ( nrstdt == 2 ) THEN 
    320321               ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 
    321322               CALL iom_get( numror, 'ndastp', zndastp ) 
    322323               ndastp = NINT( zndastp ) 
    323324               CALL iom_get( numror, 'adatrj', adatrj  ) 
    324             ELSE  
     325            ELSE 
    325326               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
    326327               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
    327                adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday  
    328                ! note this is wrong if time step has changed during run  
     328               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     329               ! note this is wrong if time step has changed during run 
    329330            ENDIF 
    330331         ELSE 
    331332            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
    332333            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
    333             adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday  
     334            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    334335         ENDIF 
    335336         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 
    … …  
    347348            IF(lwp) WRITE(numout,*) 
    348349            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt 
    349             IF(lwp) WRITE(numout,*) '~~~~~~~'          
     350            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    350351         ENDIF 
    351352         ! calendar control 
    352          CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step  
     353         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step 
    353354         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date 
    354355         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r3680 r3764  
    6868      !!              - 1D configuration, move Coriolis, u and v at T-point 
    6969      !!---------------------------------------------------------------------- 
    70       INTEGER ::   jk                ! dummy loop argument 
    71       INTEGER ::   iconf = 0         ! temporary integers 
    72       !!---------------------------------------------------------------------- 
    73       ! 
    74       IF( nn_timing == 1 )  CALL timing_start('dom_init') 
     70      INTEGER ::   jk          ! dummy loop argument 
     71      INTEGER ::   iconf = 0   ! local integers 
     72      !!---------------------------------------------------------------------- 
     73      ! 
     74      IF( nn_timing == 1 )   CALL timing_start('dom_init') 
    7575      ! 
    7676      IF(lwp) THEN 
    … …  
    8888      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh 
    8989      ! 
    90       IF( lk_c1d ) THEN                        ! 1D configuration  
    91          CALL cor_c1d                          ! Coriolis set at T-point 
    92          umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point 
    93          vmask(:,:,:) = tmask(:,:,:) 
    94       END IF 
    95       ! 
    96       hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points 
    97       hv(:,:) = 0.e0 
     90      IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
     91      ! 
     92      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points 
     93      hv(:,:) = 0._wp 
    9894      DO jk = 1, jpk 
    9995         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk) 
    … …  
    10197      END DO 
    10298      !                                        ! Inverse of the local depth 
    103       hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1) 
    104       hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1) 
     99      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
     100      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
    105101 
    106102                             CALL dom_stp      ! time step 
    … …  
    108104      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control 
    109105      ! 
    110       IF( nn_timing == 1 )  CALL timing_stop('dom_init') 
     106      IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
    111107      ! 
    112108   END SUBROUTINE dom_init 
    … …  
    294290         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 
    295291      ELSE 
    296          ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    297          ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    298          ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    299          ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    300  
    301          iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     292         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp )     
     293         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp )     
     294         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp )     
     295         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp )     
     296 
     297         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 
    302298         iimi1 = iloc(1) + nimpp - 1 
    303299         ijmi1 = iloc(2) + njmpp - 1 
    304          iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     300         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 
    305301         iimi2 = iloc(1) + nimpp - 1 
    306302         ijmi2 = iloc(2) + njmpp - 1 
    307          iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     303         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 
    308304         iima1 = iloc(1) + nimpp - 1 
    309305         ijma1 = iloc(2) + njmpp - 1 
    310          iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     306         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 
    311307         iima2 = iloc(1) + nimpp - 1 
    312308         ijma2 = iloc(2) + njmpp - 1 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r3702 r3764  
    1616   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    1717   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function 
     18   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case   
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    4041   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    4142   USE lib_mpp           ! distributed memory computing library 
    42    USE wrk_nemo        ! Memory allocation 
    43    USE timing          ! Timing 
     43   USE wrk_nemo          ! Memory allocation 
     44   USE timing            ! Timing 
    4445 
    4546   IMPLICIT NONE 
    … …  
    8485      !!                ***  ROUTINE dom_zgr  *** 
    8586      !!                    
    86       !! ** Purpose :  set the depth of model levels and the resulting  
    87       !!      vertical scale factors. 
     87      !! ** Purpose :   set the depth of model levels and the resulting  
     88      !!              vertical scale factors. 
    8889      !! 
    8990      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0) 
    … …  
    9798      !! ** Action  :   define gdep., e3., mbathy and bathy 
    9899      !!---------------------------------------------------------------------- 
    99       INTEGER ::   ioptio = 0   ! temporary integer 
     100      INTEGER ::   ioptio, ibat   ! local integer 
    100101      ! 
    101102      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 
    102103      !!---------------------------------------------------------------------- 
    103104      ! 
    104       IF( nn_timing == 1 )  CALL timing_start('dom_zgr') 
     105      IF( nn_timing == 1 )   CALL timing_start('dom_zgr') 
    105106      ! 
    106107      REWIND( numnam )                 ! Read Namelist namzgr : vertical coordinate' 
    … …  
    118119 
    119120      ioptio = 0                       ! Check Vertical coordinate options 
    120       IF( ln_zco ) ioptio = ioptio + 1 
    121       IF( ln_zps ) ioptio = ioptio + 1 
    122       IF( ln_sco ) ioptio = ioptio + 1 
     121      IF( ln_zco      )  ioptio = ioptio + 1 
     122      IF( ln_zps      )  ioptio = ioptio + 1 
     123      IF( ln_sco      )  ioptio = ioptio + 1 
    123124      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' ) 
    124125      ! 
    … …  
    127128                          CALL zgr_z            ! Reference z-coordinate system (always called) 
    128129                          CALL zgr_bat          ! Bathymetry fields (levels and meters) 
     130      IF( lk_c1d      )   CALL lbc_lnk( bathy , 'T', 1._wp )   ! 1D config.: same bathy value over the 3x3 domain 
    129131      IF( ln_zco      )   CALL zgr_zco          ! z-coordinate 
    130132      IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate 
    … …  
    134136      ! ----------------------------------- 
    135137      IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain 
    136       IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isoated ocean points 
     138      IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isolated ocean points 
    137139                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points 
    138140      ! 
    139       ! 
    140  
     141      IF( lk_c1d ) THEN                         ! 1D config.: same mbathy value over the 3x3 domain 
     142         ibat = mbathy(2,2) 
     143         mbathy(:,:) = ibat 
     144      END IF 
     145      ! 
    141146      IF( nprint == 1 .AND. lwp )   THEN 
    142147         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    … …  
    478483                    END DO 
    479484                 END DO 
    480                  IF(lwp) WRITE(numout,*) 
     485                 IF(lwp) WRITE(numout,*)      
    481486                 IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
    482487                 ! 
    … …  
    742747      ! 
    743748      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land) 
     749  
    744750      !                                     ! bottom k-index of W-level = mbkt+1 
    745751      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level 
    … …  
    12201226         END DO 
    12211227         ! 
    1222          ! Apply lateral boundary condition   CAUTION: kept the value when the lbc field is zero 
     1228         ! Apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero 
    12231229         ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1._wp ) 
    12241230         DO jj = 1, nlcj 
    … …  
    12311237      !                                                     ! ================ ! 
    12321238      ! 
    1233       !                                        ! envelop bathymetry saved in hbatt 
     1239      ! Fill ghost rows with appropriate values to avoid undefined e3 values with some mpp decompositions 
     1240      DO ji = nlci+1, jpi  
     1241         zenv(ji,1:nlcj) = zenv(nlci,1:nlcj) 
     1242      END DO 
     1243      ! 
     1244      DO jj = nlcj+1, jpj 
     1245         zenv(:,jj) = zenv(:,nlcj) 
     1246      END DO 
     1247      ! 
     1248      ! Envelope bathymetry saved in hbatt 
    12341249      hbatt(:,:) = zenv(:,:)  
    12351250      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r3680 r3764  
    4141   USE dynspg_exp      ! pressure gradient schemes 
    4242   USE dynspg_ts       ! pressure gradient schemes 
     43   USE sol_oce         ! ocean solver variables 
    4344   USE lib_mpp         ! MPP library 
    4445   USE restart         ! restart 
    … …  
    106107         hdivb(:,:,:) = 0._wp   ;   hdivn(:,:,:) = 0._wp 
    107108         ! 
    108          !                                       ! define e3u_b, e3v_b from e3t_b initialized in domzgr 
    109          CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 
    110          ! 
    111109         IF( cp_cfg == 'eel' ) THEN 
    112110            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields 
    … …  
    133131            ENDDO 
    134132         ENDIF 
     133         !                                       ! define e3u_b, e3v_b from e3t_b initialized in domzgr 
     134         CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 
    135135         !  
    136136      ENDIF 
    … …  
    138138      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file 
    139139         IF( ln_rstart ) THEN 
    140             IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields 
    141             !                                                         ! gcx, gcxb for agrif_opa_init 
    142          ENDIF                                                        ! explicit case not coded yet with AGRIF 
     140            IF( lk_dynspg_flt )  THEN      ! read or initialize the following fields 
     141               !                           ! gcx, gcxb for agrif_opa_init 
     142               IF( sol_oce_alloc()  > 0 )   CALL ctl_stop('agrif sol_oce_alloc: allocation of arrays failed') 
     143               CALL flt_rst( nit000, 'READ' ) 
     144            ENDIF 
     145         ENDIF                             ! explicit case not coded yet with AGRIF 
    143146      ENDIF 
    144147      ! 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r3632 r3764  
    1111   !!            8.5  !  2002-08  (A. Bozec)  hpg_zps: Original code 
    1212   !!   NEMO     1.0  !  2005-10  (A. Beckmann, B.W. An)  various s-coordinate options 
    13    !!                 !         Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot  
     13   !!                 !         Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot 
    1414   !!             -   !  2005-11  (G. Madec) style & small optimisation 
    1515   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    … …  
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE phycst          ! physical constants 
    33    USE trdmod          ! ocean dynamics trends  
     33   USE trdmod          ! ocean dynamics trends 
    3434   USE trdmod_oce      ! ocean variables trends 
    3535   USE in_out_manager  ! I/O manager 
    3636   USE prtctl          ! Print control 
    37    USE lbclnk          ! lateral boundary condition  
     37   USE lbclnk          ! lateral boundary condition 
    3838   USE lib_mpp         ! MPP library 
    3939   USE wrk_nemo        ! Memory Allocation 
    … …  
    4646   PUBLIC   dyn_hpg_init   ! routine called by opa module 
    4747 
    48    !                                              !!* Namelist namdyn_hpg : hydrostatic pressure gradient  
     48   !                                              !!* Namelist namdyn_hpg : hydrostatic pressure gradient 
    4949   LOGICAL , PUBLIC ::   ln_hpg_zco    = .TRUE.    !: z-coordinate - full steps 
    5050   LOGICAL , PUBLIC ::   ln_hpg_zps    = .FALSE.   !: z-coordinate - partial steps (interpolation) 
    … …  
    5454   LOGICAL , PUBLIC ::   ln_dynhpg_imp = .FALSE.   !: semi-implicite hpg flag 
    5555 
    56    INTEGER  ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 
     56   INTEGER , PUBLIC ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) (PUBLIC for TAM) 
    5757 
    5858   !! * Substitutions 
    … …  
    7070      !!                  ***  ROUTINE dyn_hpg  *** 
    7171      !! 
    72       !! ** Method  :   Call the hydrostatic pressure gradient routine  
     72      !! ** Method  :   Call the hydrostatic pressure gradient routine 
    7373      !!              using the scheme defined in the namelist 
    74       !!    
     74      !! 
    7575      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    7676      !!             - Save the trend (l_trddyn=T) 
    … …  
    8484      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    8585         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    86          ztrdu(:,:,:) = ua(:,:,:)   
    87          ztrdv(:,:,:) = va(:,:,:)  
    88       ENDIF       
     86         ztrdu(:,:,:) = ua(:,:,:) 
     87         ztrdv(:,:,:) = va(:,:,:) 
     88      ENDIF 
    8989      ! 
    9090      SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation 
    … …  
    101101         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_hpg, 'DYN', kt ) 
    102102         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    103       ENDIF           
     103      ENDIF 
    104104      ! 
    105105      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    … …  
    161161      ! 
    162162      !                               ! Consistency check 
    163       ioptio = 0  
     163      ioptio = 0 
    164164      IF( ln_hpg_zco )   ioptio = ioptio + 1 
    165165      IF( ln_hpg_zps )   ioptio = ioptio + 1 
    … …  
    185185      !!            ua = ua - 1/e1u * zhpi 
    186186      !!            va = va - 1/e2v * zhpj 
    187       !!  
     187      !! 
    188188      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    189189      !!---------------------------------------------------------------------- 
    … …  
    192192      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    193193      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    194       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    195       !!---------------------------------------------------------------------- 
    196       !   
     194      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
     195      !!---------------------------------------------------------------------- 
     196      ! 
    197197      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 
    198198      ! 
    … …  
    202202         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case ' 
    203203      ENDIF 
    204        
    205       zcoef0 = - grav * 0.5_wp      ! Local constant initialization  
     204 
     205      zcoef0 = - grav * 0.5_wp      ! Local constant initialization 
    206206 
    207207      ! Surface value 
    … …  
    247247      !!--------------------------------------------------------------------- 
    248248      !!                 ***  ROUTINE hpg_zps  *** 
    249       !!                     
     249      !! 
    250250      !! ** Method  :   z-coordinate plus partial steps case.  blahblah... 
    251       !!  
     251      !! 
    252252      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    253       !!----------------------------------------------------------------------  
     253      !!---------------------------------------------------------------------- 
    254254      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    255255      !! 
    … …  
    257257      INTEGER  ::   iku, ikv                         ! temporary integers 
    258258      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    259       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     259      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    260260      !!---------------------------------------------------------------------- 
    261261      ! 
    … …  
    363363      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    364364      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars 
    365       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     365      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    366366      !!---------------------------------------------------------------------- 
    367367      ! 
    … …  
    383383      ! Surface value 
    384384      DO jj = 2, jpjm1 
    385          DO ji = fs_2, fs_jpim1   ! vector opt.    
     385         DO ji = fs_2, fs_jpim1   ! vector opt. 
    386386            ! hydrostatic pressure gradient along s-surfaces 
    387387            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
    … …  
    397397            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    398398            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 
    399          END DO   
    400       END DO    
    401              
     399         END DO 
     400      END DO 
     401 
    402402      ! interior value (2=<jk=<jpkm1) 
    403       DO jk = 2, jpkm1                                   
    404          DO jj = 2, jpjm1      
    405             DO ji = fs_2, fs_jpim1   ! vector opt.       
     403      DO jk = 2, jpkm1 
     404         DO jj = 2, jpjm1 
     405            DO ji = fs_2, fs_jpim1   ! vector opt. 
    406406               ! hydrostatic pressure gradient along s-surfaces 
    407                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &  
    408                   &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &  
     407               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
     408                  &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
    409409                  &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
    410410               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
    … …  
    432432      !! 
    433433      !! ** Method  :   Density Jacobian with Cubic polynomial scheme 
    434       !!  
     434      !! 
    435435      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003 
    436436      !!---------------------------------------------------------------------- 
    … …  
    441441      REAL(wp) ::   z1_10, cffu, cffx   !    "         " 
    442442      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
    443       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     443      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    444444      REAL(wp), POINTER, DIMENSION(:,:,:) ::  dzx, dzy, dzz, dzu, dzv, dzw 
    445445      REAL(wp), POINTER, DIMENSION(:,:,:) ::  drhox, drhoy, drhoz, drhou, drhov, drhow 
    … …  
    447447      !!---------------------------------------------------------------------- 
    448448      ! 
    449       CALL wrk_alloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   )  
    450       CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )  
    451       CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )  
     449      CALL wrk_alloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   ) 
     450      CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
     451      CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        ) 
    452452      ! 
    453453 
    … …  
    497497               cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  ) 
    498498               cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  ) 
    499    
     499 
    500500               cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  ) 
    501501               cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  ) 
    … …  
    568568               &                     + 0.5_wp * ( rhd(ji,jj,2) - rhd(ji,jj,1) )         & 
    569569               &                              * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )   & 
    570                &                              / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  )  
     570               &                              / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  ) 
    571571         END DO 
    572572      END DO 
    … …  
    631631      ! ---------------- 
    632632      DO jk = 2, jpkm1 
    633          DO jj = 2, jpjm1  
     633         DO jj = 2, jpjm1 
    634634            DO ji = fs_2, fs_jpim1   ! vector opt. 
    635635               ! hydrostatic pressure gradient along s-surfaces 
    … …  
    647647      END DO 
    648648      ! 
    649       CALL wrk_dealloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   )  
    650       CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )  
    651       CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )  
     649      CALL wrk_dealloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   ) 
     650      CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
     651      CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        ) 
    652652      ! 
    653653   END SUBROUTINE hpg_djc 
    … …  
    676676      INTEGER  :: jk1, jis, jid, jjs, jjd 
    677677      REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps 
    678       REAL(wp) :: zrhdt1  
     678      REAL(wp) :: zrhdt1 
    679679      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
    680       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh  
     680      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh 
    681681      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    682682      !!---------------------------------------------------------------------- 
    683683      ! 
    684       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )  
    685       CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh )  
     684      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
     685      CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 
    686686      ! 
    687687      IF( kt == nit000 ) THEN 
    … …  
    693693      !!---------------------------------------------------------------------- 
    694694      ! Local constant initialization 
    695       zcoef0 = - grav  
     695      zcoef0 = - grav 
    696696      znad = 0.0_wp 
    697697      IF( lk_vvl ) znad = 1._wp 
    … …  
    700700      zhpi(:,:,:) = 0._wp 
    701701      zrhh(:,:,:) = rhd(:,:,:) 
    702        
     702 
    703703      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 
    704704      DO jj = 1, jpj 
    705         DO ji = 1, jpi    
     705        DO ji = 1, jpi 
    706706          jk = mbathy(ji,jj) 
    707707          IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp 
    … …  
    711711                zrhh(ji,jj,jkk) = interp1(fsde3w(ji,jj,jkk),   fsde3w(ji,jj,jkk-1), & 
    712712                                         fsde3w(ji,jj,jkk-2), rhd(ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
    713              END DO  
     713             END DO 
    714714          ENDIF 
    715715        END DO 
    … …  
    728728      xsp(:,:,:) = zdept(:,:,:) 
    729729 
    730       ! Construct the vertical density profile with the  
     730      ! Construct the vertical density profile with the 
    731731      ! constrained cubic spline interpolation 
    732732      ! rho(z) = asp + bsp*z + csp*z^2 + dsp*z^3 
    733       CALL cspline(fsp,xsp,asp,bsp,csp,dsp,polynomial_type)       
     733      CALL cspline(fsp,xsp,asp,bsp,csp,dsp,polynomial_type) 
    734734 
    735735      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 
    736736      DO jj = 2, jpj 
    737         DO ji = 2, jpi  
     737        DO ji = 2, jpi 
    738738          zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 
    739739                                         bsp(ji,jj,1),   csp(ji,jj,1), & 
    … …  
    741741 
    742742          ! assuming linear profile across the top half surface layer 
    743           zhpi(ji,jj,1) =  0.5_wp * fse3w(ji,jj,1) * zrhdt1   
     743          zhpi(ji,jj,1) =  0.5_wp * fse3w(ji,jj,1) * zrhdt1 
    744744        END DO 
    745745      END DO 
    746746 
    747747      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 
    748       DO jk = 2, jpkm1                                   
    749         DO jj = 2, jpj      
     748      DO jk = 2, jpkm1 
     749        DO jj = 2, jpj 
    750750          DO ji = 2, jpi 
    751751            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                          & 
    … …  
    758758 
    759759      ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 
    760       DO jj = 2, jpjm1      
    761         DO ji = 2, jpim1   
     760      DO jj = 2, jpjm1 
     761        DO ji = 2, jpim1 
    762762          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad) 
    763763          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_n(ji,jj) * znad) 
    … …  
    765765      END DO 
    766766 
    767       DO jk = 2, jpkm1                                   
    768         DO jj = 2, jpjm1      
    769           DO ji = 2, jpim1   
     767      DO jk = 2, jpkm1 
     768        DO jj = 2, jpjm1 
     769          DO ji = 2, jpim1 
    770770            zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk) 
    771771            zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk) 
    … …  
    773773        END DO 
    774774      END DO 
    775                 
    776       DO jk = 1, jpkm1                                   
    777         DO jj = 2, jpjm1      
    778           DO ji = 2, jpim1   
     775 
     776      DO jk = 1, jpkm1 
     777        DO jj = 2, jpjm1 
     778          DO ji = 2, jpim1 
    779779            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk) 
    780780            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk) 
    … …  
    795795 
    796796 
    797       DO jk = 1, jpkm1                                   
    798         DO jj = 2, jpjm1      
    799           DO ji = 2, jpim1   
     797      DO jk = 1, jpkm1 
     798        DO jj = 2, jpjm1 
     799          DO ji = 2, jpim1 
    800800            zpwes = 0._wp; zpwed = 0._wp 
    801801            zpnss = 0._wp; zpnsd = 0._wp 
    … …  
    812812 
    813813               ! integrate the pressure on the shallow side 
    814                jk1 = jk  
     814               jk1 = jk 
    815815               DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
    816816                 IF( jk1 == mbku(ji,jj) ) THEN 
    … …  
    819819                 ENDIF 
    820820                 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
    821                  zpwes = zpwes +                                    &  
     821                 zpwes = zpwes +                                    & 
    822822                      integ_spline(zdept(jis,jj,jk1), zdeps,            & 
    823823                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
    … …  
    825825                 jk1 = jk1 + 1 
    826826               END DO 
    827              
     827 
    828828               ! integrate the pressure on the deep side 
    829                jk1 = jk  
     829               jk1 = jk 
    830830               DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
    831831                 IF( jk1 == 1 ) THEN 
    … …  
    838838                 ENDIF 
    839839                 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
    840                  zpwed = zpwed +                                        &  
     840                 zpwed = zpwed +                                        & 
    841841                        integ_spline(zdeps,              zdept(jid,jj,jk1), & 
    842842                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
    … …  
    844844                 jk1 = jk1 - 1 
    845845               END DO 
    846              
     846 
    847847               ! update the momentum trends in u direction 
    848848 
    849849               zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
    850850               IF( lk_vvl ) THEN 
    851                  zdpdx2 = zcoef0 / e1u(ji,jj) * &  
    852                          ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )  
     851                 zdpdx2 = zcoef0 / e1u(ji,jj) * & 
     852                         ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 
    853853                ELSE 
    854                  zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)  
     854                 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
    855855               ENDIF 
    856856 
    … …  
    858858               &           umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 
    859859            ENDIF 
    860    
     860 
    861861            !!!!!     for v equation 
    862862            IF( jk <= mbkv(ji,jj) ) THEN 
    … …  
    868868 
    869869               ! integrate the pressure on the shallow side 
    870                jk1 = jk  
     870               jk1 = jk 
    871871               DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
    872872                 IF( jk1 == mbkv(ji,jj) ) THEN 
    … …  
    875875                 ENDIF 
    876876                 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
    877                  zpnss = zpnss +                                      &  
     877                 zpnss = zpnss +                                      & 
    878878                        integ_spline(zdept(ji,jjs,jk1), zdeps,            & 
    879879                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
    … …  
    881881                 jk1 = jk1 + 1 
    882882               END DO 
    883              
     883 
    884884               ! integrate the pressure on the deep side 
    885                jk1 = jk  
     885               jk1 = jk 
    886886               DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
    887887                 IF( jk1 == 1 ) THEN 
    … …  
    894894                 ENDIF 
    895895                 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
    896                  zpnsd = zpnsd +                                        &  
     896                 zpnsd = zpnsd +                                        & 
    897897                        integ_spline(zdeps,              zdept(ji,jjd,jk1), & 
    898898                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
    … …  
    900900                 jk1 = jk1 - 1 
    901901               END DO 
    902              
     902 
    903903 
    904904               ! update the momentum trends in v direction 
    … …  
    907907               IF( lk_vvl ) THEN 
    908908                   zdpdy2 = zcoef0 / e2v(ji,jj) * & 
    909                            ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )  
     909                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
    910910               ELSE 
    911                    zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )  
     911                   zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    912912               ENDIF 
    913913 
    … …  
    916916            ENDIF 
    917917 
    918                      
     918 
    919919           END DO 
    920920        END DO 
    921921      END DO 
    922922      ! 
    923       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )  
    924       CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )  
     923      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
     924      CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 
    925925      ! 
    926926   END SUBROUTINE hpg_prj 
    … …  
    929929      !!---------------------------------------------------------------------- 
    930930      !!                 ***  ROUTINE cspline  *** 
    931       !!        
     931      !! 
    932932      !! ** Purpose :   constrained cubic spline interpolation 
    933       !!           
    934       !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3  
     933      !! 
     934      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 
    935935      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    936936      !! 
    … …  
    938938      IMPLICIT NONE 
    939939      REAL(wp), DIMENSION(:,:,:), INTENT(in)  :: fsp, xsp           ! value and coordinate 
    940       REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of  
     940      REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of 
    941941                                                                    ! the interpoated function 
    942       INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline  
     942      INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline 
    943943                                                                    ! 2: Linear 
    944944 
    945       ! Local Variables       
     945      ! Local Variables 
    946946      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    947947      INTEGER  ::   jpi, jpj, jpkm1 
    … …  
    955955      jpkm1 = size(fsp,3) - 1 
    956956 
    957        
     957 
    958958      IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline 
    959959         DO ji = 1, jpi 
    960960            DO jj = 1, jpj 
    961            !!Fritsch&Butland's method, 1984 (preferred, but more computation)               
     961           !!Fritsch&Butland's method, 1984 (preferred, but more computation) 
    962962           !    DO jk = 2, jpkm1-1 
    963            !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1)   
    964            !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)   
     963           !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1) 
     964           !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    965965           !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1 
    966966           !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2 
    967967           ! 
    968968           !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 
    969            !      
     969           ! 
    970970           !       IF(zdf1 * zdf2 <= 0._wp) THEN 
    971971           !           zdf(jk) = 0._wp 
    … …  
    974974           !       ENDIF 
    975975           !    END DO 
    976             
     976 
    977977           !!Simply geometric average 
    978978               DO jk = 2, jpkm1-1 
    979979                  zdf1 = (fsp(ji,jj,jk) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk) - xsp(ji,jj,jk-1)) 
    980980                  zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk)) 
    981              
     981 
    982982                  IF(zdf1 * zdf2 <= 0._wp) THEN 
    983983                     zdf(jk) = 0._wp 
    … …  
    986986                  ENDIF 
    987987               END DO 
    988             
     988 
    989989               zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 
    990990                          &          ( xsp(ji,jj,2) - xsp(ji,jj,1) ) -  0.5_wp * zdf(2) 
    … …  
    992992                          &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - & 
    993993                          & 0.5_wp * zdf(jpkm1 - 1) 
    994     
     994 
    995995               DO jk = 1, jpkm1 - 1 
    996                  zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)  
     996                 zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    997997                 ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 
    998998                 ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 
    999                  zddf1  = -2._wp * ztmp1 + ztmp2  
     999                 zddf1  = -2._wp * ztmp1 + ztmp2 
    10001000                 ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 
    1001                  zddf2  =  2._wp * ztmp1 - ztmp2  
    1002        
     1001                 zddf2  =  2._wp * ztmp1 - ztmp2 
     1002 
    10031003                 dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 
    10041004                 csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 
    1005                  bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - &  
     1005                 bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - & 
    10061006                               & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 
    10071007                               & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - & 
    … …  
    10131013            END DO 
    10141014         END DO 
    1015   
     1015 
    10161016      ELSE IF (polynomial_type == 2) THEN     ! Linear 
    10171017         DO ji = 1, jpi 
    10181018            DO jj = 1, jpj 
    10191019               DO jk = 1, jpkm1-1 
    1020                   zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk)  
     1020                  zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    10211021                  ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 
    1022     
     1022 
    10231023                  dsp(ji,jj,jk) = 0._wp 
    10241024                  csp(ji,jj,jk) = 0._wp 
    … …  
    10331033      ENDIF 
    10341034 
    1035        
     1035 
    10361036   END SUBROUTINE cspline 
    10371037 
    10381038 
    1039    FUNCTION interp1(x, xl, xr, fl, fr)  RESULT(f)  
     1039   FUNCTION interp1(x, xl, xr, fl, fr)  RESULT(f) 
    10401040      !!---------------------------------------------------------------------- 
    10411041      !!                 ***  ROUTINE interp1  *** 
    1042       !!        
     1042      !! 
    10431043      !! ** Purpose :   1-d linear interpolation 
    1044       !!           
    1045       !! ** Method  :   
     1044      !! 
     1045      !! ** Method  : 
    10461046      !!                interpolation is straight forward 
    1047       !!                extrapolation is also permitted (no value limit)  
     1047      !!                extrapolation is also permitted (no value limit) 
    10481048      !! 
    10491049      !!---------------------------------------------------------------------- 
    10501050      IMPLICIT NONE 
    1051       REAL(wp), INTENT(in) ::  x, xl, xr, fl, fr    
     1051      REAL(wp), INTENT(in) ::  x, xl, xr, fl, fr 
    10521052      REAL(wp)             ::  f ! result of the interpolation (extrapolation) 
    10531053      REAL(wp)             ::  zdeltx 
    … …  
    10601060        f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx 
    10611061      ENDIF 
    1062        
     1062 
    10631063   END FUNCTION interp1 
    10641064 
    1065    FUNCTION interp2(x, a, b, c, d)  RESULT(f)  
     1065   FUNCTION interp2(x, a, b, c, d)  RESULT(f) 
    10661066      !!---------------------------------------------------------------------- 
    10671067      !!                 ***  ROUTINE interp1  *** 
    1068       !!        
     1068      !! 
    10691069      !! ** Purpose :   1-d constrained cubic spline interpolation 
    1070       !!           
     1070      !! 
    10711071      !! ** Method  :  cubic spline interpolation 
    10721072      !! 
    10731073      !!---------------------------------------------------------------------- 
    10741074      IMPLICIT NONE 
    1075       REAL(wp), INTENT(in) ::  x, a, b, c, d    
     1075      REAL(wp), INTENT(in) ::  x, a, b, c, d 
    10761076      REAL(wp)             ::  f ! value from the interpolation 
    10771077      !!---------------------------------------------------------------------- 
    10781078 
    1079       f = a + x* ( b + x * ( c + d * x ) )  
     1079      f = a + x* ( b + x * ( c + d * x ) ) 
    10801080 
    10811081   END FUNCTION interp2 
    10821082 
    10831083 
    1084    FUNCTION interp3(x, a, b, c, d)  RESULT(f)  
     1084   FUNCTION interp3(x, a, b, c, d)  RESULT(f) 
    10851085      !!---------------------------------------------------------------------- 
    10861086      !!                 ***  ROUTINE interp1  *** 
    1087       !!        
     1087      !! 
    10881088      !! ** Purpose :   Calculate the first order of deriavtive of 
    10891089      !!                a cubic spline function y=a+b*x+c*x^2+d*x^3 
    1090       !!           
     1090      !! 
    10911091      !! ** Method  :   f=dy/dx=b+2*c*x+3*d*x^2 
    10921092      !! 
    10931093      !!---------------------------------------------------------------------- 
    10941094      IMPLICIT NONE 
    1095       REAL(wp), INTENT(in) ::  x, a, b, c, d    
     1095      REAL(wp), INTENT(in) ::  x, a, b, c, d 
    10961096      REAL(wp)             ::  f ! value from the interpolation 
    10971097      !!---------------------------------------------------------------------- 
    … …  
    11011101   END FUNCTION interp3 
    11021102 
    1103     
    1104    FUNCTION integ_spline(xl, xr, a, b, c, d)  RESULT(f)  
     1103 
     1104   FUNCTION integ_spline(xl, xr, a, b, c, d)  RESULT(f) 
    11051105      !!---------------------------------------------------------------------- 
    11061106      !!                 ***  ROUTINE interp1  *** 
    1107       !!        
     1107      !! 
    11081108      !! ** Purpose :   1-d constrained cubic spline integration 
    1109       !!           
    1110       !! ** Method  :  integrate polynomial a+bx+cx^2+dx^3 from xl to xr  
     1109      !! 
     1110      !! ** Method  :  integrate polynomial a+bx+cx^2+dx^3 from xl to xr 
    11111111      !! 
    11121112      !!---------------------------------------------------------------------- 
    11131113      IMPLICIT NONE 
    1114       REAL(wp), INTENT(in) ::  xl, xr, a, b, c, d    
    1115       REAL(wp)             ::  za1, za2, za3       
     1114      REAL(wp), INTENT(in) ::  xl, xr, a, b, c, d 
     1115      REAL(wp)             ::  za1, za2, za3 
    11161116      REAL(wp)             ::  f                   ! integration result 
    11171117      !!---------------------------------------------------------------------- 
    11181118 
    1119       za1 = 0.5_wp * b  
    1120       za2 = c / 3.0_wp  
    1121       za3 = 0.25_wp * d  
     1119      za1 = 0.5_wp * b 
     1120      za2 = c / 3.0_wp 
     1121      za3 = 0.25_wp * d 
    11221122 
    11231123      f  = xr * ( a + xr * ( za1 + xr * ( za2 + za3 * xr ) ) ) - & 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r3294 r3764  
    156156# if defined key_obc 
    157157      !                                !* OBC open boundaries 
    158       CALL obc_dyn( kt ) 
     158      IF( lk_obc ) CALL obc_dyn( kt ) 
    159159      ! 
    160160      IF( .NOT. lk_dynspg_flt ) THEN 
    … …  
    163163         !                                       sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T) 
    164164         !                              - Correct the barotropic velocities 
    165          CALL obc_dyn_bt( kt ) 
     165         IF( lk_obc ) CALL obc_dyn_bt( kt ) 
    166166         ! 
    167167!!gm ERROR - potential BUG: sshn should not be modified at this stage !!   ssh_nxt not alrady called 
    168168         CALL lbc_lnk( sshn, 'T', 1. )         ! Boundary conditions on sshn 
    169169         ! 
    170          IF( ln_vol_cst )   CALL obc_vol( kt ) 
     170         IF( lk_obc .AND. ln_vol_cst )   CALL obc_vol( kt ) 
    171171         ! 
    172172         IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh      : ', mask1=tmask ) 
    … …  
    175175# elif defined key_bdy 
    176176      !                                !* BDY open boundaries 
    177       IF( lk_dynspg_exp ) CALL bdy_dyn( kt ) 
    178       IF( lk_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 
     177      IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt ) 
     178      IF( lk_bdy .AND. lk_dynspg_ts  ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 
    179179 
    180180!!$   Do we need a call to bdy_vol here?? 
    … …  
    248248               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap:  
    249249                  DO jj = 1, jpj                      !                   applied on thickness weighted velocity 
    250                      DO ji = 1, jpim1                 !                              --------------------------- 
     250                     DO ji = 1, jpi                   !                              --------------------------- 
    251251                        zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 
    252252                        zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 
    … …  
    268268               fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor 
    269269               fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
    270                CALL lbc_lnk( ub, 'U', -1. )                    ! lateral boundary conditions 
    271                CALL lbc_lnk( vb, 'V', -1. ) 
    272270            ENDIF 
    273271            ! 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r3680 r3764  
    187187 
    188188#if defined key_obc 
    189       CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm 
    190       CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system 
     189      IF( lk_obc ) CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm 
     190      IF( lk_obc ) CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system 
    191191#endif 
    192192#if defined key_bdy 
    193       CALL bdy_dyn( kt )      ! Update velocities on each open boundary 
    194       CALL bdy_vol( kt )      ! Correction of the barotropic component velocity to control the volume of the system 
     193      IF( lk_bdy ) CALL bdy_dyn( kt )   ! Update velocities on each open boundary 
     194      IF( lk_bdy ) CALL bdy_vol( kt )   ! Correction of the barotropic component velocity to control the volume of the system 
    195195#endif 
    196196#if defined key_agrif 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r3680 r3764  
    181181#if defined key_bdy 
    182182      ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    183       CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    184 #endif 
    185  
     183      CALL lbc_lnk( ssha, 'T', 1. )                    ! absolutly compulsory !! (jmm) 
     184#endif 
     185#if defined key_asminc 
     186      !                                                ! Include the IAU weighted SSH increment 
     187      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
     188         CALL ssh_asm_inc( kt ) 
     189         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
     190      ENDIF 
     191#endif 
    186192      !                                                ! Sea Surface Height at u-,v- and f-points (vvl case only) 
    187193      IF( lk_vvl ) THEN                                ! (required only in key_vvl case) 
    … …  
    198204         CALL lbc_lnk( sshu_a, 'U', 1. )   ;   CALL lbc_lnk( sshv_a, 'V', 1. )      ! Boundaries conditions 
    199205      ENDIF 
    200        
    201 #if defined key_asminc 
    202       !                                                ! Include the IAU weighted SSH increment 
    203       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    204          CALL ssh_asm_inc( kt ) 
    205          ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    206       ENDIF 
    207 #endif 
    208206 
    209207      !                                           !------------------------------! 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r3737 r3764  
    44   !! Input/Output manager :  Library to read input files 
    55   !!==================================================================== 
    6    !! History :  9.0  ! 05 12  (J. Belier) Original code 
    7    !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
    8    !!             "   ! 07 07  (D. Storkey) Changes to iom_gettime 
     6   !! History :  2.0  ! 2005-12  (J. Belier) Original code 
     7   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO 
     8   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime 
     9   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case   
    910   !!-------------------------------------------------------------------- 
    10    !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
    1111 
    1212   !!-------------------------------------------------------------------- 
    … …  
    1919   !!-------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
     21   USE c1d             ! 1D vertical configuration 
    2122   USE flo_oce         ! floats module declarations 
    2223   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    … …  
    761762            ENDIF 
    762763             
     764            ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 
     765            IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( pv_r2d,'Z',1. ) 
     766            IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( pv_r3d,'Z',1. ) 
     767     
    763768            !--- Apply scale_factor and offset 
    764769            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r3680 r3764  
    1010   !!                            and lbc_obc_lnk' routine to optimize   
    1111   !!                            the BDY/OBC communications 
    12    !!---------------------------------------------------------------------- 
    13 #if   defined key_mpp_mpi 
     12   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case   
     13   !!---------------------------------------------------------------------- 
     14#if defined key_mpp_mpi 
    1415   !!---------------------------------------------------------------------- 
    1516   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    … …  
    9394CONTAINS 
    9495 
     96# if defined key_c1d 
     97   !!---------------------------------------------------------------------- 
     98   !!   'key_c1d'                                          1D configuration 
     99   !!---------------------------------------------------------------------- 
     100 
     101   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
     102      !!--------------------------------------------------------------------- 
     103      !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
     104      !! 
     105      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case) 
     106      !! 
     107      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2 
     108      !!---------------------------------------------------------------------- 
     109      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
     110      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
     111      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
     112      !!---------------------------------------------------------------------- 
     113      ! 
     114      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
     115      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
     116      ! 
     117   END SUBROUTINE lbc_lnk_3d_gather 
     118 
     119 
     120   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
     121      !!--------------------------------------------------------------------- 
     122      !!                  ***  ROUTINE lbc_lnk_3d  *** 
     123      !! 
     124      !! ** Purpose :   set lateral boundary conditions on a 3D array (C1D case) 
     125      !! 
     126      !! ** Method  :   1D case, the central water column is set everywhere 
     127      !!---------------------------------------------------------------------- 
     128      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     129      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     130      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
     131      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     132      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     133      ! 
     134      INTEGER  ::   jk     ! dummy loop index 
     135      REAL(wp) ::   ztab   ! local scalar 
     136      !!---------------------------------------------------------------------- 
     137      ! 
     138      DO jk = 1, jpk 
     139         ztab = pt3d(2,2,jk) 
     140         pt3d(:,:,jk) = ztab 
     141      END DO 
     142      ! 
     143   END SUBROUTINE lbc_lnk_3d 
     144 
     145 
     146   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     147      !!--------------------------------------------------------------------- 
     148      !!                 ***  ROUTINE lbc_lnk_2d  *** 
     149      !! 
     150      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
     151      !! 
     152      !! ** Method  :   1D case, the central water column is set everywhere 
     153      !!---------------------------------------------------------------------- 
     154      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     155      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
     156      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
     157      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     158      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     159      ! 
     160      REAL(wp) ::   ztab   ! local scalar 
     161      !!---------------------------------------------------------------------- 
     162      ! 
     163      ztab = pt2d(2,2) 
     164      pt2d(:,:) = ztab 
     165      ! 
     166   END SUBROUTINE lbc_lnk_2d 
     167 
     168#else 
     169   !!---------------------------------------------------------------------- 
     170   !!   Default option                           3D shared memory computing 
     171   !!---------------------------------------------------------------------- 
     172 
    95173   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    96174      !!--------------------------------------------------------------------- 
    … …  
    138216 
    139217      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    140       ELSE                         ;   zland = 0.e0 
     218      ELSE                         ;   zland = 0._wp 
    141219      ENDIF 
    142220 
    … …  
    261339 
    262340      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    263       ELSE                         ;   zland = 0.e0 
     341      ELSE                         ;   zland = 0._wp 
    264342      ENDIF 
    265343 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3680 r3764  
    1717   !!             -   !  2008  (R. Benshila) add mpp_ini_ice 
    1818   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd 
    19    !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl  
     19   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
    2020   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager 
    2121   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d',  
    … …  
    3030   !!   get_unit    : give the index of an unused logical unit 
    3131   !!---------------------------------------------------------------------- 
    32 #if   defined key_mpp_mpi   
     32#if   defined key_mpp_mpi 
    3333   !!---------------------------------------------------------------------- 
    3434   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    … …  
    5555   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 
    5656   !!---------------------------------------------------------------------- 
    57    USE dom_oce        ! ocean space and time domain  
     57   USE dom_oce        ! ocean space and time domain 
    5858   USE lbcnfd         ! north fold treatment 
    5959   USE in_out_manager ! I/O manager 
    … …  
    6161   IMPLICIT NONE 
    6262   PRIVATE 
    63     
     63 
    6464   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn 
    6565   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free 
    … …  
    7070   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
    7171   PUBLIC   mppsize 
    72    PUBLIC   mppsend, mpprecv                          ! needed by ICB routines 
     72   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    7373   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
    7474   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    … …  
    9090   END INTERFACE 
    9191   INTERFACE mpp_lbc_north 
    92       MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d  
     92      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
    9393   END INTERFACE 
    9494   INTERFACE mpp_minloc 
    … …  
    9898      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
    9999   END INTERFACE 
    100     
     100 
    101101   !! ========================= !! 
    102102   !!  MPI  variable definition !! 
    … …  
    105105   INCLUDE 'mpif.h' 
    106106!$AGRIF_END_DO_NOT_TREAT 
    107     
     107 
    108108   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag 
    109109 
    110110   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2) 
    111     
     111 
    112112   INTEGER ::   mppsize        ! number of process 
    113113   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    … …  
    132132   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average 
    133133   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
    134     
    135    ! North fold condition in mpp_mpi with jpni > 1 
    136    INTEGER ::   ngrp_world        ! group ID for the world processors 
    137    INTEGER ::   ngrp_opa          ! group ID for the opa processors 
    138    INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold) 
    139    INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north 
    140    INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !) 
    141    INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line 
    142    INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm 
    143    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   ! dimension ndim_rank_north 
     134 
     135   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) 
     136   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors 
     137   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors 
     138   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold) 
     139   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north 
     140   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !) 
     141   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line 
     142   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm 
     143   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north 
    144144 
    145145   ! Type of send : standard, buffered, immediate 
    146    CHARACTER(len=1)        ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    147    LOGICAL         , PUBLIC ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
    148    INTEGER                  ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
    149        
     146   CHARACTER(len=1), PUBLIC ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
     147   LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
     148   INTEGER, PUBLIC          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
     149 
    150150   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend 
    151151 
    … …  
    177177   ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 
    178178   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours 
    179    INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges  
     179   INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges 
    180180   INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto 
    181181   INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto 
    … …  
    228228      !!---------------------------------------------------------------------- 
    229229      !!                  ***  routine mynode  *** 
    230       !!                     
     230      !! 
    231231      !! ** Purpose :   Find processor unit 
    232232      !!---------------------------------------------------------------------- 
    233       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
    234       INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit  
    235       INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator  
     233      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
     234      INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit 
     235      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
    236236      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    237237      ! 
    … …  
    257257#if defined key_agrif 
    258258      IF( .NOT. Agrif_Root() ) THEN 
    259          jpni  = Agrif_Parent(jpni )  
     259         jpni  = Agrif_Parent(jpni ) 
    260260         jpnj  = Agrif_Parent(jpnj ) 
    261261         jpnij = Agrif_Parent(jpnij) 
    … …  
    281281      CALL mpi_initialized ( mpi_was_called, code ) 
    282282      IF( code /= MPI_SUCCESS ) THEN 
    283          DO ji = 1, SIZE(ldtxt)  
     283         DO ji = 1, SIZE(ldtxt) 
    284284            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    285          END DO          
     285         END DO 
    286286         WRITE(*, cform_err) 
    287287         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    … …  
    296296         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    297297            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1 
    298             IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )  
     298            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
    299299         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    300300            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1 
    … …  
    329329      ENDIF 
    330330 
    331       IF( PRESENT(localComm) ) THEN  
     331      IF( PRESENT(localComm) ) THEN 
    332332         IF( Agrif_Root() ) THEN 
    333333            mpi_comm_opa = localComm 
    … …  
    336336         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    337337         IF( code /= MPI_SUCCESS ) THEN 
    338             DO ji = 1, SIZE(ldtxt)  
     338            DO ji = 1, SIZE(ldtxt) 
    339339               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    340340            END DO 
    … …  
    343343            CALL mpi_abort( mpi_comm_world, code, ierr ) 
    344344         ENDIF 
    345       ENDIF  
     345      ENDIF 
    346346 
    347347      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    348348      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    349349      mynode = mpprank 
    350       !  
     350      ! 
    351351      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
    352352      ! 
    … …  
    721721      !! ** Purpose :   Message passing manadgement 
    722722      !! 
    723       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     723      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    724724      !!      between processors following neighboring subdomains. 
    725725      !!            domain parameters 
    … …  
    728728      !!                    nbondi : mark for "east-west local boundary" 
    729729      !!                    nbondj : mark for "north-south local boundary" 
    730       !!                    noea   : number for local neighboring processors  
     730      !!                    noea   : number for local neighboring processors 
    731731      !!                    nowe   : number for local neighboring processors 
    732732      !!                    noso   : number for local neighboring processors 
    … …  
    741741      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    742742      !                                                             ! =  1. , the sign is kept 
    743       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
     743      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    744744      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    745745      !! 
    … …  
    762762         DO jk = 1, jpk 
    763763            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    764                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)    
     764               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
    765765               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    766766               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
    … …  
    773773         END DO 
    774774         ! 
    775       ELSE                              ! standard close or cyclic treatment  
     775      ELSE                              ! standard close or cyclic treatment 
    776776         ! 
    777777         !                                   ! East-West boundaries 
    … …  
    792792      ! 2. East and west directions exchange 
    793793      ! ------------------------------------ 
    794       ! we play with the neigbours AND the row number because of the periodicity  
     794      ! we play with the neigbours AND the row number because of the periodicity 
    795795      ! 
    796796      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    … …  
    801801            t3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    802802         END DO 
    803       END SELECT   
     803      END SELECT 
    804804      ! 
    805805      !                           ! Migrations 
    806806      imigr = jpreci * jpj * jpk 
    807807      ! 
    808       SELECT CASE ( nbondi )  
     808      SELECT CASE ( nbondi ) 
    809809      CASE ( -1 ) 
    810810         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 
    … …  
    832832            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
    833833         END DO 
    834       CASE ( 0 )  
     834      CASE ( 0 ) 
    835835         DO jl = 1, jpreci 
    836836            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
    … …  
    859859      imigr = jprecj * jpi * jpk 
    860860      ! 
    861       SELECT CASE ( nbondj )      
     861      SELECT CASE ( nbondj ) 
    862862      CASE ( -1 ) 
    863863         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    … …  
    871871         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    872872         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    873       CASE ( 1 )  
     873      CASE ( 1 ) 
    874874         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    875875         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
    … …  
    885885            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
    886886         END DO 
    887       CASE ( 0 )  
     887      CASE ( 0 ) 
    888888         DO jl = 1, jprecj 
    889889            ptab(:,jl      ,:) = t3sn(:,jl,:,2) 
    … …  
    915915      !!---------------------------------------------------------------------- 
    916916      !!                  ***  routine mpp_lnk_2d  *** 
    917       !!                   
     917      !! 
    918918      !! ** Purpose :   Message passing manadgement for 2d array 
    919919      !! 
    920       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     920      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    921921      !!      between processors following neighboring subdomains. 
    922922      !!            domain parameters 
    … …  
    925925      !!                    nbondi : mark for "east-west local boundary" 
    926926      !!                    nbondj : mark for "north-south local boundary" 
    927       !!                    noea   : number for local neighboring processors  
     927      !!                    noea   : number for local neighboring processors 
    928928      !!                    nowe   : number for local neighboring processors 
    929929      !!                    noso   : number for local neighboring processors 
    … …  
    936936      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    937937      !                                                         ! =  1. , the sign is kept 
    938       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
     938      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    939939      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    940940      !! 
    … …  
    957957         ! WARNING pt2d is defined only between nld and nle 
    958958         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    959             pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)    
     959            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
    960960            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    961961            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
    … …  
    967967         END DO 
    968968         ! 
    969       ELSE                              ! standard close or cyclic treatment  
     969      ELSE                              ! standard close or cyclic treatment 
    970970         ! 
    971971         !                                   ! East-West boundaries 
    … …  
    986986      ! 2. East and west directions exchange 
    987987      ! ------------------------------------ 
    988       ! we play with the neigbours AND the row number because of the periodicity  
     988      ! we play with the neigbours AND the row number because of the periodicity 
    989989      ! 
    990990      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    … …  
    10841084            pt2d(:,ijhom+jl) = t2ns(:,jl,2) 
    10851085         END DO 
    1086       CASE ( 1 )  
     1086      CASE ( 1 ) 
    10871087         DO jl = 1, jprecj 
    10881088            pt2d(:,jl      ) = t2sn(:,jl,2) 
    … …  
    11121112      !! ** Purpose :   Message passing manadgement for two 3D arrays 
    11131113      !! 
    1114       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     1114      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    11151115      !!      between processors following neighboring subdomains. 
    11161116      !!            domain parameters 
    … …  
    11191119      !!                    nbondi : mark for "east-west local boundary" 
    11201120      !!                    nbondj : mark for "north-south local boundary" 
    1121       !!                    noea   : number for local neighboring processors  
     1121      !!                    noea   : number for local neighboring processors 
    11221122      !!                    nowe   : number for local neighboring processors 
    11231123      !!                    noso   : number for local neighboring processors 
    … …  
    11271127      !! 
    11281128      !!---------------------------------------------------------------------- 
    1129       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which  
     1129      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
    11301130      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied 
    1131       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays  
     1131      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
    11321132      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points 
    11331133      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary 
    … …  
    11551155      ENDIF 
    11561156 
    1157        
     1157 
    11581158      !                                      ! North-South boundaries 
    11591159      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point 
    … …  
    11651165      ! 2. East and west directions exchange 
    11661166      ! ------------------------------------ 
    1167       ! we play with the neigbours AND the row number because of the periodicity  
     1167      ! we play with the neigbours AND the row number because of the periodicity 
    11681168      ! 
    11691169      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    … …  
    11811181      imigr = jpreci * jpj * jpk *2 
    11821182      ! 
    1183       SELECT CASE ( nbondi )  
     1183      SELECT CASE ( nbondi ) 
    11841184      CASE ( -1 ) 
    11851185         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 
    … …  
    12081208            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2) 
    12091209         END DO 
    1210       CASE ( 0 )  
     1210      CASE ( 0 ) 
    12111211         DO jl = 1, jpreci 
    12121212            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2) 
    … …  
    12401240      imigr = jprecj * jpi * jpk * 2 
    12411241      ! 
    1242       SELECT CASE ( nbondj )      
     1242      SELECT CASE ( nbondj ) 
    12431243      CASE ( -1 ) 
    12441244         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 
    … …  
    12521252         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    12531253         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    1254       CASE ( 1 )  
     1254      CASE ( 1 ) 
    12551255         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
    12561256         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 
    … …  
    12671267            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2) 
    12681268         END DO 
    1269       CASE ( 0 )  
     1269      CASE ( 0 ) 
    12701270         DO jl = 1, jprecj 
    12711271            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2) 
    … …  
    12871287         ! 
    12881288         SELECT CASE ( jpni ) 
    1289          CASE ( 1 )                                            
     1289         CASE ( 1 ) 
    12901290            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs. 
    12911291            CALL lbc_nfd      ( ptab2, cd_type2, psgn ) 
    … …  
    12931293            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs. 
    12941294            CALL mpp_lbc_north (ptab2, cd_type2, psgn) 
    1295          END SELECT  
     1295         END SELECT 
    12961296         ! 
    12971297      ENDIF 
    … …  
    13031303      !!---------------------------------------------------------------------- 
    13041304      !!                  ***  routine mpp_lnk_2d_e  *** 
    1305       !!                   
     1305      !! 
    13061306      !! ** Purpose :   Message passing manadgement for 2d array (with halo) 
    13071307      !! 
    1308       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     1308      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    13091309      !!      between processors following neighboring subdomains. 
    13101310      !!            domain parameters 
    … …  
    13151315      !!                    nbondi : mark for "east-west local boundary" 
    13161316      !!                    nbondj : mark for "north-south local boundary" 
    1317       !!                    noea   : number for local neighboring processors  
     1317      !!                    noea   : number for local neighboring processors 
    13181318      !!                    nowe   : number for local neighboring processors 
    13191319      !!                    noso   : number for local neighboring processors 
    … …  
    13511351      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point 
    13521352                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north 
    1353                                  
     1353 
    13541354      !                                      ! East-West boundaries 
    13551355      !                                           !* Cyclic east-west 
    … …  
    13711371         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
    13721372         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               ) 
    1373          END SELECT  
     1373         END SELECT 
    13741374         ! 
    13751375      ENDIF 
    … …  
    13771377      ! 2. East and west directions exchange 
    13781378      ! ------------------------------------ 
    1379       ! we play with the neigbours AND the row number because of the periodicity  
     1379      ! we play with the neigbours AND the row number because of the periodicity 
    13801380      ! 
    13811381      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    … …  
    14631463      ! 
    14641464      !                           ! Write Dirichlet lateral conditions 
    1465       ijhom = nlcj - jprecj   
     1465      ijhom = nlcj - jprecj 
    14661466      ! 
    14671467      SELECT CASE ( nbondj ) 
    … …  
    14751475            pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 
    14761476         END DO 
    1477       CASE ( 1 )  
     1477      CASE ( 1 ) 
    14781478         DO jl = 1, iprecj 
    14791479            pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
    … …  
    14871487      !!---------------------------------------------------------------------- 
    14881488      !!                  ***  routine mppsend  *** 
    1489       !!                    
     1489      !! 
    14901490      !! ** Purpose :   Send messag passing array 
    14911491      !! 
    … …  
    15231523      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess 
    15241524      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message 
    1525       INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number  
     1525      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number 
    15261526      !! 
    15271527      INTEGER :: istatus(mpi_status_size) 
    … …  
    15311531      ! 
    15321532 
    1533       ! If a specific process number has been passed to the receive call,  
     1533      ! If a specific process number has been passed to the receive call, 
    15341534      ! use that one. Default is to use mpi_any_source 
    15351535      use_source=mpi_any_source 
    … …  
    15461546      !!---------------------------------------------------------------------- 
    15471547      !!                   ***  routine mppgather  *** 
    1548       !!                    
    1549       !! ** Purpose :   Transfert between a local subdomain array and a work  
     1548      !! 
     1549      !! ** Purpose :   Transfert between a local subdomain array and a work 
    15501550      !!     array which is distributed following the vertical level. 
    15511551      !! 
    … …  
    15601560      itaille = jpi * jpj 
    15611561      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   & 
    1562          &                            mpi_double_precision, kp , mpi_comm_opa, ierror )  
     1562         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
    15631563      ! 
    15641564   END SUBROUTINE mppgather 
    … …  
    15691569      !!                  ***  routine mppscatter  *** 
    15701570      !! 
    1571       !! ** Purpose :   Transfert between awork array which is distributed  
     1571      !! ** Purpose :   Transfert between awork array which is distributed 
    15721572      !!      following the vertical level and the local subdomain array. 
    15731573      !! 
    … …  
    15911591      !!---------------------------------------------------------------------- 
    15921592      !!                  ***  routine mppmax_a_int  *** 
    1593       !!  
     1593      !! 
    15941594      !! ** Purpose :   Find maximum value in an integer layout array 
    15951595      !! 
    … …  
    15971597      INTEGER , INTENT(in   )                  ::   kdim   ! size of array 
    15981598      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array 
    1599       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   !  
     1599      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
    16001600      !! 
    16011601      INTEGER :: ierror, localcomm   ! temporary integer 
    … …  
    16221622      INTEGER, INTENT(inout)           ::   ktab      ! ??? 
    16231623      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ??? 
    1624       !!  
     1624      !! 
    16251625      INTEGER ::   ierror, iwork, localcomm   ! temporary integer 
    16261626      !!---------------------------------------------------------------------- 
    16271627      ! 
    1628       localcomm = mpi_comm_opa  
     1628      localcomm = mpi_comm_opa 
    16291629      IF( PRESENT(kcom) )   localcomm = kcom 
    16301630      ! 
    … …  
    16391639      !!---------------------------------------------------------------------- 
    16401640      !!                  ***  routine mppmin_a_int  *** 
    1641       !!  
     1641      !! 
    16421642      !! ** Purpose :   Find minimum value in an integer layout array 
    16431643      !! 
    … …  
    16871687      !!---------------------------------------------------------------------- 
    16881688      !!                  ***  routine mppsum_a_int  *** 
    1689       !!                     
     1689      !! 
    16901690      !! ** Purpose :   Global integer sum, 1D array case 
    16911691      !! 
    … …  
    17081708      !!---------------------------------------------------------------------- 
    17091709      !!                 ***  routine mppsum_int  *** 
    1710       !!                   
     1710      !! 
    17111711      !! ** Purpose :   Global integer sum 
    17121712      !! 
    17131713      !!---------------------------------------------------------------------- 
    17141714      INTEGER, INTENT(inout) ::   ktab 
    1715       !!  
     1715      !! 
    17161716      INTEGER :: ierror, iwork 
    17171717      !!---------------------------------------------------------------------- 
    … …  
    17271727      !!---------------------------------------------------------------------- 
    17281728      !!                 ***  routine mppmax_a_real  *** 
    1729       !!                   
     1729      !! 
    17301730      !! ** Purpose :   Maximum 
    17311731      !! 
    … …  
    17511751      !!---------------------------------------------------------------------- 
    17521752      !!                  ***  routine mppmax_real  *** 
    1753       !!                     
     1753      !! 
    17541754      !! ** Purpose :   Maximum 
    17551755      !! 
    … …  
    17621762      !!---------------------------------------------------------------------- 
    17631763      ! 
    1764       localcomm = mpi_comm_opa  
     1764      localcomm = mpi_comm_opa 
    17651765      IF( PRESENT(kcom) )   localcomm = kcom 
    17661766      ! 
    … …  
    17741774      !!---------------------------------------------------------------------- 
    17751775      !!                 ***  routine mppmin_a_real  *** 
    1776       !!                   
     1776      !! 
    17771777      !! ** Purpose :   Minimum of REAL, array case 
    17781778      !! 
    … …  
    17861786      !!----------------------------------------------------------------------- 
    17871787      ! 
    1788       localcomm = mpi_comm_opa  
     1788      localcomm = mpi_comm_opa 
    17891789      IF( PRESENT(kcom) ) localcomm = kcom 
    17901790      ! 
    … …  
    17981798      !!---------------------------------------------------------------------- 
    17991799      !!                  ***  routine mppmin_real  *** 
    1800       !!  
     1800      !! 
    18011801      !! ** Purpose :   minimum of REAL, scalar case 
    18021802      !! 
    18031803      !!----------------------------------------------------------------------- 
    1804       REAL(wp), INTENT(inout)           ::   ptab        !  
     1804      REAL(wp), INTENT(inout)           ::   ptab        ! 
    18051805      INTEGER , INTENT(in   ), OPTIONAL :: kcom 
    18061806      !! 
    … …  
    18101810      !!----------------------------------------------------------------------- 
    18111811      ! 
    1812       localcomm = mpi_comm_opa  
     1812      localcomm = mpi_comm_opa 
    18131813      IF( PRESENT(kcom) )   localcomm = kcom 
    18141814      ! 
    … …  
    18221822      !!---------------------------------------------------------------------- 
    18231823      !!                  ***  routine mppsum_a_real  *** 
    1824       !!  
     1824      !! 
    18251825      !! ** Purpose :   global sum, REAL ARRAY argument case 
    18261826      !! 
    … …  
    18311831      !! 
    18321832      INTEGER                   ::   ierror    ! temporary integer 
    1833       INTEGER                   ::   localcomm  
    1834       REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace  
     1833      INTEGER                   ::   localcomm 
     1834      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
    18351835      !!----------------------------------------------------------------------- 
    18361836      ! 
    1837       localcomm = mpi_comm_opa  
     1837      localcomm = mpi_comm_opa 
    18381838      IF( PRESENT(kcom) )   localcomm = kcom 
    18391839      ! 
    … …  
    18471847      !!---------------------------------------------------------------------- 
    18481848      !!                  ***  routine mppsum_real  *** 
    1849       !!               
     1849      !! 
    18501850      !! ** Purpose :   global sum, SCALAR argument case 
    18511851      !! 
    … …  
    18541854      INTEGER , INTENT(in   ), OPTIONAL ::   kcom 
    18551855      !! 
    1856       INTEGER  ::   ierror, localcomm  
     1856      INTEGER  ::   ierror, localcomm 
    18571857      REAL(wp) ::   zwork 
    18581858      !!----------------------------------------------------------------------- 
    18591859      ! 
    1860       localcomm = mpi_comm_opa  
     1860      localcomm = mpi_comm_opa 
    18611861      IF( PRESENT(kcom) ) localcomm = kcom 
    18621862      ! 
    … …  
    18911891 
    18921892   END SUBROUTINE mppsum_realdd 
    1893    
    1894    
     1893 
     1894 
    18951895   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
    18961896      !!---------------------------------------------------------------------- 
    … …  
    19181918 
    19191919   END SUBROUTINE mppsum_a_realdd 
    1920     
     1920 
    19211921   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
    19221922      !!------------------------------------------------------------------------ 
    … …  
    20132013      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab 
    20142014      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame 
    2015       !!   
     2015      !! 
    20162016      INTEGER  :: ierror 
    20172017      INTEGER, DIMENSION (2)   ::   ilocs 
    … …  
    20522052      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab 
    20532053      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame 
    2054       !!    
     2054      !! 
    20552055      REAL(wp) :: zmax   ! local maximum 
    20562056      REAL(wp), DIMENSION(2,1) ::   zain, zaout 
    … …  
    20822082      !!---------------------------------------------------------------------- 
    20832083      !!                  ***  routine mppsync  *** 
    2084       !!                    
     2084      !! 
    20852085      !! ** Purpose :   Massively parallel processors, synchroneous 
    20862086      !! 
    … …  
    20972097      !!---------------------------------------------------------------------- 
    20982098      !!                  ***  routine mppstop  *** 
    2099       !!                    
     2099      !! 
    21002100      !! ** purpose :   Stop massively parallel processors method 
    21012101      !! 
    … …  
    21132113      !!---------------------------------------------------------------------- 
    21142114      !!                  ***  routine mppobc  *** 
    2115       !!  
     2115      !! 
    21162116      !! ** Purpose :   Message passing manadgement for open boundary 
    21172117      !!     conditions array 
    … …  
    21242124      !!                    nbondi : mark for "east-west local boundary" 
    21252125      !!                    nbondj : mark for "north-south local boundary" 
    2126       !!                    noea   : number for local neighboring processors  
     2126      !!                    noea   : number for local neighboring processors 
    21272127      !!                    nowe   : number for local neighboring processors 
    21282128      !!                    noso   : number for local neighboring processors 
    … …  
    23072307      ! 
    23082308   END SUBROUTINE mppobc 
    2309     
     2309 
    23102310 
    23112311   SUBROUTINE mpp_comm_free( kcom ) 
    … …  
    23662366      kice = 0 
    23672367      DO jjproc = 1, jpnij 
    2368          IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1     
     2368         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1 
    23692369      END DO 
    23702370      ! 
    23712371      zwork = 0 
    23722372      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr ) 
    2373       ndim_rank_ice = SUM( zwork )           
     2373      ndim_rank_ice = SUM( zwork ) 
    23742374 
    23752375      ! Allocate the right size to nrank_north 
    … …  
    23772377      ALLOCATE( nrank_ice(ndim_rank_ice) ) 
    23782378      ! 
    2379       ii = 0      
     2379      ii = 0 
    23802380      nrank_ice = 0 
    23812381      DO jjproc = 1, jpnij 
    23822382         IF( zwork(jjproc) == 1) THEN 
    23832383            ii = ii + 1 
    2384             nrank_ice(ii) = jjproc -1  
     2384            nrank_ice(ii) = jjproc -1 
    23852385         ENDIF 
    23862386      END DO 
    … …  
    24642464         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl) 
    24652465         ALLOCATE(nrank_znl(ndim_rank_znl)) 
    2466          ii = 0      
     2466         ii = 0 
    24672467         nrank_znl (:) = 0 
    24682468         DO jproc=1,jpnij 
    24692469            IF ( kwork(jproc) == njmpp) THEN 
    24702470               ii = ii + 1 
    2471                nrank_znl(ii) = jproc -1  
     2471               nrank_znl(ii) = jproc -1 
    24722472            ENDIF 
    24732473         END DO 
    … …  
    24932493 
    24942494      ! Determines if processor if the first (starting from i=1) on the row 
    2495       IF ( jpni == 1 ) THEN  
     2495      IF ( jpni == 1 ) THEN 
    24962496         l_znl_root = .TRUE. 
    24972497      ELSE 
    … …  
    25112511      !!               ***  routine mpp_ini_north  *** 
    25122512      !! 
    2513       !! ** Purpose :   Initialize special communicator for north folding  
     2513      !! ** Purpose :   Initialize special communicator for north folding 
    25142514      !!      condition together with global variables needed in the mpp folding 
    25152515      !! 
    … …  
    25722572      !!                   ***  routine mpp_lbc_north_3d  *** 
    25732573      !! 
    2574       !! ** Purpose :   Ensure proper north fold horizontal bondary condition  
     2574      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    25752575      !!              in mpp configuration in case of jpn1 > 1 
    25762576      !! 
    25772577      !! ** Method  :   North fold condition and mpp with more than one proc 
    2578       !!              in i-direction require a specific treatment. We gather  
     2578      !!              in i-direction require a specific treatment. We gather 
    25792579      !!              the 4 northern lines of the global domain on 1 processor 
    25802580      !!              and apply lbc north-fold on this sub array. Then we 
    … …  
    25852585      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    25862586      !                                                              !   = T ,  U , V , F or W  gridpoints 
    2587       REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
     2587      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
    25882588      !!                                                             ! =  1. , the sign is kept 
    25892589      INTEGER ::   ji, jj, jr 
    … …  
    25942594      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    25952595      !!---------------------------------------------------------------------- 
    2596       !    
     2596      ! 
    25972597      ijpj   = 4 
    25982598      ityp = -1 
    … …  
    26092609      IF ( l_north_nogather ) THEN 
    26102610         ! 
    2611          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2611         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
    26122612         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    26132613         ! 
    … …  
    26342634               ityp = 5 
    26352635            CASE DEFAULT 
    2636                ityp = -1                    ! Set a default value for unsupported types which  
     2636               ityp = -1                    ! Set a default value for unsupported types which 
    26372637                                            ! will cause a fallback to the mpi_allgather method 
    26382638         END SELECT 
    … …  
    26832683      ! The ztab array has been either: 
    26842684      !  a. Fully populated by the mpi_allgather operation or 
    2685       !  b. Had the active points for this domain and northern neighbours populated  
     2685      !  b. Had the active points for this domain and northern neighbours populated 
    26862686      !     by peer to peer exchanges 
    2687       ! Either way the array may be folded by lbc_nfd and the result for the span of  
     2687      ! Either way the array may be folded by lbc_nfd and the result for the span of 
    26882688      ! this domain will be identical. 
    26892689      ! 
    … …  
    27042704      !!                   ***  routine mpp_lbc_north_2d  *** 
    27052705      !! 
    2706       !! ** Purpose :   Ensure proper north fold horizontal bondary condition  
     2706      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    27072707      !!              in mpp configuration in case of jpn1 > 1 (for 2d array ) 
    27082708      !! 
    27092709      !! ** Method  :   North fold condition and mpp with more than one proc 
    2710       !!              in i-direction require a specific treatment. We gather  
     2710      !!              in i-direction require a specific treatment. We gather 
    27112711      !!              the 4 northern lines of the global domain on 1 processor 
    27122712      !!              and apply lbc north-fold on this sub array. Then we 
    … …  
    27172717      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    27182718      !                                                          !   = T ,  U , V , F or W  gridpoints 
    2719       REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
     2719      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
    27202720      !!                                                             ! =  1. , the sign is kept 
    27212721      INTEGER ::   ji, jj, jr 
    … …  
    27412741      IF ( l_north_nogather ) THEN 
    27422742         ! 
    2743          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2743         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
    27442744         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    27452745         ! 
    … …  
    27662766               ityp = 5 
    27672767            CASE DEFAULT 
    2768                ityp = -1                    ! Set a default value for unsupported types which  
     2768               ityp = -1                    ! Set a default value for unsupported types which 
    27692769                                            ! will cause a fallback to the mpi_allgather method 
    27702770         END SELECT 
    … …  
    28162816      ! The ztab array has been either: 
    28172817      !  a. Fully populated by the mpi_allgather operation or 
    2818       !  b. Had the active points for this domain and northern neighbours populated  
     2818      !  b. Had the active points for this domain and northern neighbours populated 
    28192819      !     by peer to peer exchanges 
    2820       ! Either way the array may be folded by lbc_nfd and the result for the span of  
     2820      ! Either way the array may be folded by lbc_nfd and the result for the span of 
    28212821      ! this domain will be identical. 
    28222822      ! 
    … …  
    28382838      !!                   ***  routine mpp_lbc_north_2d  *** 
    28392839      !! 
    2840       !! ** Purpose :   Ensure proper north fold horizontal bondary condition  
    2841       !!              in mpp configuration in case of jpn1 > 1 and for 2d  
     2840      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
     2841      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
    28422842      !!              array with outer extra halo 
    28432843      !! 
    28442844      !! ** Method  :   North fold condition and mpp with more than one proc 
    2845       !!              in i-direction require a specific treatment. We gather  
    2846       !!              the 4+2*jpr2dj northern lines of the global domain on 1  
    2847       !!              processor and apply lbc north-fold on this sub array.  
     2845      !!              in i-direction require a specific treatment. We gather 
     2846      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
     2847      !!              processor and apply lbc north-fold on this sub array. 
    28482848      !!              Then we scatter the north fold array back to the processors. 
    28492849      !! 
    … …  
    28522852      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points 
    28532853      !                                                                                         !   = T ,  U , V , F or W -points 
    2854       REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the   
     2854      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the 
    28552855      !!                                                                                        ! north fold, =  1. otherwise 
    28562856      INTEGER ::   ji, jj, jr 
    … …  
    28952895      !! Scatter back to pt2d 
    28962896      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj 
    2897       ij  = ij +1  
     2897      ij  = ij +1 
    28982898         DO ji= 1, nlci 
    28992899            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 
    … …  
    33393339      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment 
    33403340      !!            but classical mpi_init 
    3341       !!  
    3342       !! History :: 01/11 :: IDRIS initial version for IBM only   
     3341      !! 
     3342      !! History :: 01/11 :: IDRIS initial version for IBM only 
    33433343      !!            08/04 :: R. Benshila, generalisation 
    33443344      !!--------------------------------------------------------------------- 
    3345       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
     3345      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
    33463346      INTEGER                      , INTENT(inout) ::   ksft 
    33473347      INTEGER                      , INTENT(  out) ::   code 
    … …  
    33523352      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization 
    33533353      IF ( code /= MPI_SUCCESS ) THEN 
    3354          DO ji = 1, SIZE(ldtxt)  
     3354         DO ji = 1, SIZE(ldtxt) 
    33553355            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    3356          END DO          
     3356         END DO 
    33573357         WRITE(*, cform_err) 
    33583358         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized' 
    … …  
    33643364         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code ) 
    33653365         IF ( code /= MPI_SUCCESS ) THEN 
    3366             DO ji = 1, SIZE(ldtxt)  
     3366            DO ji = 1, SIZE(ldtxt) 
    33673367               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    33683368            END DO 
    … …  
    33773377         ! Buffer allocation and attachment 
    33783378         ALLOCATE( tampon(nn_buffer), stat = ierr ) 
    3379          IF( ierr /= 0 ) THEN  
    3380             DO ji = 1, SIZE(ldtxt)  
     3379         IF( ierr /= 0 ) THEN 
     3380            DO ji = 1, SIZE(ldtxt) 
    33813381               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    33823382            END DO 
    … …  
    34573457   FUNCTION mynode( ldtxt, kumnam, kstop, localComm ) RESULT (function_value) 
    34583458      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    3459       CHARACTER(len=*),DIMENSION(:) ::   ldtxt  
     3459      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
    34603460      INTEGER ::   kumnam, kstop 
    34613461      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
    … …  
    34693469      REAL   , DIMENSION(:) :: parr 
    34703470      INTEGER               :: kdim 
    3471       INTEGER, OPTIONAL     :: kcom  
     3471      INTEGER, OPTIONAL     :: kcom 
    34723472      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom 
    34733473   END SUBROUTINE mpp_sum_as 
    … …  
    34763476      REAL   , DIMENSION(:,:) :: parr 
    34773477      INTEGER               :: kdim 
    3478       INTEGER, OPTIONAL     :: kcom  
     3478      INTEGER, OPTIONAL     :: kcom 
    34793479      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom 
    34803480   END SUBROUTINE mpp_sum_a2s 
    … …  
    34833483      INTEGER, DIMENSION(:) :: karr 
    34843484      INTEGER               :: kdim 
    3485       INTEGER, OPTIONAL     :: kcom  
     3485      INTEGER, OPTIONAL     :: kcom 
    34863486      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom 
    34873487   END SUBROUTINE mpp_sum_ai 
    … …  
    34893489   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine 
    34903490      REAL                  :: psca 
    3491       INTEGER, OPTIONAL     :: kcom  
     3491      INTEGER, OPTIONAL     :: kcom 
    34923492      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom 
    34933493   END SUBROUTINE mpp_sum_s 
    … …  
    34953495   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine 
    34963496      integer               :: kint 
    3497       INTEGER, OPTIONAL     :: kcom  
     3497      INTEGER, OPTIONAL     :: kcom 
    34983498      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom 
    34993499   END SUBROUTINE mpp_sum_i 
    … …  
    35043504      WRITE(*,*) 'mppsum_realdd: You should not have seen this print! error?', ytab 
    35053505   END SUBROUTINE mppsum_realdd 
    3506   
     3506 
    35073507   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
    35083508      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab 
    … …  
    35153515      REAL   , DIMENSION(:) :: parr 
    35163516      INTEGER               :: kdim 
    3517       INTEGER, OPTIONAL     :: kcom  
     3517      INTEGER, OPTIONAL     :: kcom 
    35183518      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom 
    35193519   END SUBROUTINE mppmax_a_real 
    … …  
    35213521   SUBROUTINE mppmax_real( psca, kcom ) 
    35223522      REAL                  :: psca 
    3523       INTEGER, OPTIONAL     :: kcom  
     3523      INTEGER, OPTIONAL     :: kcom 
    35243524      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom 
    35253525   END SUBROUTINE mppmax_real 
    … …  
    35283528      REAL   , DIMENSION(:) :: parr 
    35293529      INTEGER               :: kdim 
    3530       INTEGER, OPTIONAL     :: kcom  
     3530      INTEGER, OPTIONAL     :: kcom 
    35313531      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom 
    35323532   END SUBROUTINE mppmin_a_real 
    … …  
    35343534   SUBROUTINE mppmin_real( psca, kcom ) 
    35353535      REAL                  :: psca 
    3536       INTEGER, OPTIONAL     :: kcom  
     3536      INTEGER, OPTIONAL     :: kcom 
    35373537      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom 
    35383538   END SUBROUTINE mppmin_real 
    … …  
    35413541      INTEGER, DIMENSION(:) :: karr 
    35423542      INTEGER               :: kdim 
    3543       INTEGER, OPTIONAL     :: kcom  
     3543      INTEGER, OPTIONAL     :: kcom 
    35443544      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    35453545   END SUBROUTINE mppmax_a_int 
    … …  
    35473547   SUBROUTINE mppmax_int( kint, kcom) 
    35483548      INTEGER               :: kint 
    3549       INTEGER, OPTIONAL     :: kcom  
     3549      INTEGER, OPTIONAL     :: kcom 
    35503550      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom 
    35513551   END SUBROUTINE mppmax_int 
    … …  
    35543554      INTEGER, DIMENSION(:) :: karr 
    35553555      INTEGER               :: kdim 
    3556       INTEGER, OPTIONAL     :: kcom  
     3556      INTEGER, OPTIONAL     :: kcom 
    35573557      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    35583558   END SUBROUTINE mppmin_a_int 
    … …  
    35603560   SUBROUTINE mppmin_int( kint, kcom ) 
    35613561      INTEGER               :: kint 
    3562       INTEGER, OPTIONAL     :: kcom  
     3562      INTEGER, OPTIONAL     :: kcom 
    35633563      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    35643564   END SUBROUTINE mppmin_int 
    … …  
    36473647      !!                  ***  ROUTINE  stop_opa  *** 
    36483648      !! 
    3649       !! ** Purpose :   print in ocean.outpput file a error message and  
     3649      !! ** Purpose :   print in ocean.outpput file a error message and 
    36503650      !!                increment the error number (nstop) by one. 
    36513651      !!---------------------------------------------------------------------- 
    … …  
    36543654      !!---------------------------------------------------------------------- 
    36553655      ! 
    3656       nstop = nstop + 1  
     3656      nstop = nstop + 1 
    36573657      IF(lwp) THEN 
    36583658         WRITE(numout,cform_err) 
    … …  
    36863686      !!                  ***  ROUTINE  stop_warn  *** 
    36873687      !! 
    3688       !! ** Purpose :   print in ocean.outpput file a error message and  
     3688      !! ** Purpose :   print in ocean.outpput file a error message and 
    36893689      !!                increment the warning number (nwarn) by one. 
    36903690      !!---------------------------------------------------------------------- 
    … …  
    36923692      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10 
    36933693      !!---------------------------------------------------------------------- 
    3694       !  
    3695       nwarn = nwarn + 1  
     3694      ! 
     3695      nwarn = nwarn + 1 
    36963696      IF(lwp) THEN 
    36973697         WRITE(numout,cform_war) 
    … …  
    37793779         STOP 'ctl_opn bad opening' 
    37803780      ENDIF 
    3781        
     3781 
    37823782   END SUBROUTINE ctl_opn 
    37833783 
    … …  
    37893789      !! ** Purpose :   return the index of an unused logical unit 
    37903790      !!---------------------------------------------------------------------- 
    3791       LOGICAL :: llopn  
     3791      LOGICAL :: llopn 
    37923792      !!---------------------------------------------------------------------- 
    37933793      ! 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r3294 r3764  
    121121      ALLOCATE( ltemsk(jpj,jpk) , luemsk(jpj,jpk) , lvemsk(jpj,jpk) ,     & 
    122122         &      ltwmsk(jpj,jpk) , luwmsk(jpj,jpk) , lvwmsk(jpj,jpk) ,     & 
    123          &      ltnmsk(jpj,jpk) , lunmsk(jpj,jpk) , lvnmsk(jpj,jpk) ,     & 
    124          &      ltsmsk(jpj,jpk) , lusmsk(jpj,jpk) , lvsmsk(jpj,jpk) , STAT=ierr(2) ) 
     123         &      ltnmsk(jpi,jpk) , lunmsk(jpi,jpk) , lvnmsk(jpi,jpk) ,     & 
     124         &      ltsmsk(jpi,jpk) , lusmsk(jpi,jpk) , lvsmsk(jpi,jpk) , STAT=ierr(2) ) 
    125125 
    126126      obc_dta_alloc = MAXVAL( ierr ) 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3680 r3764  
    854854         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
    855855         sdf(jf)%vcomp   = sdf_n(jf)%vcomp 
    856          sdf(jf)%rotn    = .FALSE. 
     856         sdf(jf)%rotn    = .TRUE. 
    857857      END DO 
    858858 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90

    r3651 r3764  
    105105         rcc(:,:) = zconvrad * glamt(:,:) - rpi 
    106106         ! time of midday 
    107          rtmd(:,:) = 0.5 - glamt(:,:) / 360. 
    108          rtmd(:,:) = MOD( (rtmd(:,:) + 1.), 1. ) 
     107         rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp 
     108         rtmd(:,:) = MOD( (rtmd(:,:) + 1._wp) , 1._wp) 
    109109      ENDIF 
    110110 
    … …  
    121121         zdsws = REAL(11 + nday_year, wp) 
    122122         ! declination of the earths orbit 
    123          zdecrad = (-23.5 * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) ) 
     123         zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) ) 
    124124         ! Compute A and B needed to compute the time integral of the diurnal cycle 
    125125 
    … …  
    138138         DO jj = 1, jpj 
    139139            DO ji = 1, jpi 
    140                IF ( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h 
     140               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
    141141         ! When is it night? 
    142142                  ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 
    143143                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx ) 
    144144         ! is it dawn or dusk? 
    145                   IF ( ztest > 0 ) THEN 
     145                  IF ( ztest > 0._wp ) THEN 
    146146                     rdawn(ji,jj) = ztx 
    147147                     rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) ) 
    … …  
    151151                  ENDIF 
    152152               ELSE 
    153                   rdawn(ji,jj) = rtmd(ji,jj) + 0.5 
     153                  rdawn(ji,jj) = rtmd(ji,jj) + 0.5_wp 
    154154                  rdusk(ji,jj) = rdawn(ji,jj) 
    155155               ENDIF 
    … …  
    158158         rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp ) 
    159159         rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp ) 
    160          !     2.2 Compute the scalling function: 
    161          !         S* = the inverse of the time integral of the diurnal cycle from dawm to dusk 
     160         !     2.2 Compute the scaling function: 
     161         !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk 
     162         !         Avoid possible infinite scaling factor, associated with very short daylight 
     163         !         periods, by ignoring periods less than 1/1000th of a day (ticket #1040) 
    162164         DO jj = 1, jpj 
    163165            DO ji = 1, jpi 
    164                IF ( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h 
     166               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
     167                  rscal(ji,jj) = 0.0_wp 
    165168                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part 
    166                      rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    167                      rscal(ji,jj) = 1. / rscal(ji,jj) 
     169                     IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN 
     170                       rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
     171                       rscal(ji,jj) = 1._wp / rscal(ji,jj) 
     172                     ENDIF 
    168173                  ELSE                                         ! day time in two parts 
    169                      rscal(ji,jj) = fintegral(0., rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   & 
    170                         &         + fintegral(rdawn(ji,jj), 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    171                      rscal(ji,jj) = 1. / rscal(ji,jj) 
     174                     IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN 
     175                       rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   & 
     176                          &         + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
     177                       rscal(ji,jj) = 1. / rscal(ji,jj) 
     178                     ENDIF 
    172179                  ENDIF 
    173180               ELSE 
    174181                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day 
    175                      rscal(ji,jj) = fintegral(0., 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
    176                      rscal(ji,jj) = 1. / rscal(ji,jj) 
     182                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))  
     183                     rscal(ji,jj) = 1._wp / rscal(ji,jj) 
    177184                  ELSE                                          ! No day 
    178                      rscal(ji,jj) = 0.e0 
     185                     rscal(ji,jj) = 0.0_wp 
    179186                  ENDIF 
    180187               ENDIF 
    … …  
    193200         DO ji = 1, jpi 
    194201            ztmpm = 0.0 
    195             IF( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h 
     202            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h 
    196203               ! 
    197204               IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part 
    … …  
    227234                  ! 
    228235               ELSE                                         ! No day 
    229                   zqsrout(ji,jj) = 0.e0 
     236                  zqsrout(ji,jj) = 0.0_wp 
    230237                  imask_night(ji,jj) = 1 
    231238               ENDIF 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3740 r3764  
    218218         IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    219219      ENDIF 
    220  
    221       !!---------------------------------------------------------------------- 
    222       !!   Other SBC modules to initialise come here 
    223       !!---------------------------------------------------------------------- 
    224  
    225       CALL sbc_ssm_init 
    226  
    227       IF( nn_ice == 4 )   CALL cice_sbc_init (nsbc) 
    228       ! 
    229       !!---------------------------------------------------------------------- 
     220      ! 
     221      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     222      ! 
     223      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     224      ! 
    230225   END SUBROUTINE sbc_init 
    231226 
    … …  
    397392   END SUBROUTINE sbc 
    398393 
     394 
    399395   SUBROUTINE sbc_final 
    400396      !!--------------------------------------------------------------------- 
    401397      !!                    ***  ROUTINE sbc_final  *** 
     398      !! 
     399      !! ** Purpose :   Finalize CICE (if used) 
    402400      !!--------------------------------------------------------------------- 
    403  
    404       !----------------------------------------------------------------- 
    405       ! Finalize CICE (if used) 
    406       !----------------------------------------------------------------- 
    407  
     401      ! 
    408402      IF( nn_ice == 4 )   CALL cice_sbc_final 
    409403      ! 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3680 r3764  
    66   !! History :  OPA  ! 2000-11  (R. Hordoir, E. Durand)  NetCDF FORMAT 
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    8    !!            3.0  ! 2006-07  (G. Madec)  Surface module  
     8   !!            3.0  ! 2006-07  (G. Madec)  Surface module 
    99   !!            3.2  ! 2009-04  (B. Lemaire)  Introduce iom_put 
    1010   !!            3.3  ! 2010-10  (R. Furner, G. Madec) runoff distributed over ocean levels 
    … …  
    3131   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module 
    3232   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module 
    33  
     33   PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM) 
    3434   !                                                     !!* namsbc_rnf namelist * 
    3535   CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files 
    3636   LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file 
    37    LOGICAL           , PUBLIC ::   ln_rnf_tem   = .false. !: temperature river runoffs attribute specified in a file  
    38    LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file  
     37   LOGICAL           , PUBLIC ::   ln_rnf_tem   = .false. !: temperature river runoffs attribute specified in a file 
     38   LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file 
    3939   LOGICAL           , PUBLIC ::   ln_rnf_emp   = .false. !: runoffs into a file to be read or already into precipitation 
    4040   TYPE(FLD_N)       , PUBLIC ::   sn_rnf                 !: information about the runoff file to be read 
    4141   TYPE(FLD_N)       , PUBLIC ::   sn_cnf                 !: information about the runoff mouth file to be read 
    42    TYPE(FLD_N)                ::   sn_s_rnf               !: information about the salinities of runoff file to be read   
    43    TYPE(FLD_N)                ::   sn_t_rnf               !: information about the temperatures of runoff file to be read   
     42   TYPE(FLD_N)                ::   sn_s_rnf               !: information about the salinities of runoff file to be read 
     43   TYPE(FLD_N)                ::   sn_t_rnf               !: information about the temperatures of runoff file to be read 
    4444   TYPE(FLD_N)                ::   sn_dep_rnf             !: information about the depth which river inflow affects 
    4545   LOGICAL           , PUBLIC ::   ln_rnf_mouth = .false. !: specific treatment in mouths vicinity 
    … …  
    5353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m 
    5454   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s] 
    56     
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]    
    5756 
    5857   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
    … …  
    8584      !!---------------------------------------------------------------------- 
    8685      !!                  ***  ROUTINE sbc_rnf  *** 
    87       !!        
     86      !! 
    8887      !! ** Purpose :   Introduce a climatological run off forcing 
    8988      !! 
    90       !! ** Method  :   Set each river mouth with a monthly climatology  
     89      !! ** Method  :   Set each river mouth with a monthly climatology 
    9190      !!                provided from different data. 
    9291      !!                CAUTION : upward water flux, runoff forced to be < 0 
    … …  
    9897      INTEGER  ::   ji, jj   ! dummy loop indices 
    9998      !!---------------------------------------------------------------------- 
    100       !                                    
     99      ! 
    101100      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures 
    102101 
    … …  
    113112         !                                                !-------------------! 
    114113         ! 
    115                              CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt  
     114                             CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
    116115         IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
    117116         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    … …  
    132131            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    133132               rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    134                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 )                 ! if missing data value use SST as runoffs temperature   
     133               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 )                 ! if missing data value use SST as runoffs temperature 
    135134                   rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    136135               END WHERE 
    137136            ELSE                                                        ! use SST as runoffs temperature 
    138137               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    139             ENDIF   
    140             !                                                           ! use runoffs salinity data  
     138            ENDIF 
     139            !                                                           ! use runoffs salinity data 
    141140            IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    142141            !                                                           ! else use S=0 for runoffs (done one for all in the init) 
    143142            ! 
    144143            IF( ln_rnf_tem .OR. ln_rnf_sal ) THEN                 ! runoffs as outflow: use ocean SST and SSS 
    145                WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain  
     144               WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain 
    146145                  rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    147146                  rnf_tsc(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * r1_rau0 
    … …  
    157156         !                                             ! ---------------------------------------- ! 
    158157         IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    159             & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN  
     158            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
    160159            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file' 
    161160            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff 
    … …  
    164163         ELSE                                                   !* no restart: set from nit000 values 
    165164            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    166              rnf_b    (:,:  ) = rnf    (:,:  )   
    167              rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)    
     165             rnf_b    (:,:  ) = rnf    (:,:  ) 
     166             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    168167         ENDIF 
    169168      ENDIF 
    … …  
    186185      !!---------------------------------------------------------------------- 
    187186      !!                  ***  ROUTINE sbc_rnf  *** 
    188       !!        
     187      !! 
    189188      !! ** Purpose :   update the horizontal divergence with the runoff inflow 
    190189      !! 
    191       !! ** Method  :    
    192       !!                CAUTION : rnf is positive (inflow) decreasing the  
     190      !! ** Method  : 
     191      !!                CAUTION : rnf is positive (inflow) decreasing the 
    193192      !!                          divergence and expressed in m/s 
    194193      !! 
    … …  
    204203      ! 
    205204      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==! 
    206          IF( lk_vvl ) THEN             ! variable volume case  
     205         IF( lk_vvl ) THEN             ! variable volume case 
    207206            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
    208207               DO ji = 1, jpi 
    209                   h_rnf(ji,jj) = 0._wp  
     208                  h_rnf(ji,jj) = 0._wp 
    210209                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres 
    211                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box  
    212                   END DO  
     210                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
     211                  END DO 
    213212                  !                          ! apply the runoff input flow 
    214213                  DO jk = 1, nk_rnf(ji,jj) 
    … …  
    246245      !! ** Action  : - read parameters 
    247246      !!---------------------------------------------------------------------- 
    248       CHARACTER(len=32) ::   rn_dep_file   ! runoff file name   
     247      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
    249248      INTEGER           ::   ji, jj, jk    ! dummy loop indices 
    250249      INTEGER           ::   ierror, inum  ! temporary integer 
    251250      ! 
    252251      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    253          &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &   
    254          &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact   
     252         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
     253         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact 
    255254      !!---------------------------------------------------------------------- 
    256255      ! 
    … …  
    264263      sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         ) 
    265264 
    266       sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )   
    267       sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )   
    268       sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  )   
     265      sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  ) 
     266      sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  ) 
     267      sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  ) 
    269268      ! 
    270269      REWIND ( numnam )                         ! Read Namelist namsbc_rnf 
    … …  
    281280         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf 
    282281         WRITE(numout,*) '      depth of river mouth additional mixing     rn_hrnf      = ', rn_hrnf 
    283          WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact     
     282         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact 
    284283      ENDIF 
    285284      ! 
    … …  
    294293         IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations' 
    295294         IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN 
    296            CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' )  
     295           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
    297296           ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE. 
    298297         ENDIF 
    … …  
    320319            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
    321320            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
    322             CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )   
     321            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
    323322         ENDIF 
    324323         ! 
    … …  
    332331            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
    333332            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
    334             CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )   
    335          ENDIF 
    336          ! 
    337          IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file  
     333            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
     334         ENDIF 
     335         ! 
     336         IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
    338337            IF(lwp) WRITE(numout,*) 
    339338            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
    340             rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )   
    341             CALL iom_open ( rn_dep_file, inum )                           ! open file   
    342             CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array   
    343             CALL iom_close( inum )                                        ! close file   
     339            rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
     340            CALL iom_open ( rn_dep_file, inum )                           ! open file 
     341            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
     342            CALL iom_close( inum )                                        ! close file 
    344343            ! 
    345344            nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    346             DO jj = 1, jpj   
    347                DO ji = 1, jpi   
    348                   IF( h_rnf(ji,jj) > 0._wp ) THEN   
    349                      jk = 2   
    350                      DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO   
    351                      nk_rnf(ji,jj) = jk   
    352                   ELSEIF( h_rnf(ji,jj) == -1   ) THEN   ;  nk_rnf(ji,jj) = 1   
    353                   ELSEIF( h_rnf(ji,jj) == -999 ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
    354                   ELSEIF( h_rnf(ji,jj) /=  0   ) THEN   
    355                      CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )   
    356                      WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj)   
    357                   ENDIF   
    358                END DO   
    359             END DO   
    360             DO jj = 1, jpj                                ! set the associated depth  
    361                DO ji = 1, jpi  
     345            DO jj = 1, jpj 
     346               DO ji = 1, jpi 
     347                  IF( h_rnf(ji,jj) > 0._wp ) THEN 
     348                     jk = 2 
     349                     DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO 
     350                     nk_rnf(ji,jj) = jk 
     351                  ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
     352                  ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     353                  ELSE 
     354                     CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
     355                     WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) 
     356                  ENDIF 
     357               END DO 
     358            END DO 
     359            DO jj = 1, jpj                                ! set the associated depth 
     360               DO ji = 1, jpi 
    362361                  h_rnf(ji,jj) = 0._wp 
    363                   DO jk = 1, nk_rnf(ji,jj)                         
    364                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   
     362                  DO jk = 1, nk_rnf(ji,jj) 
     363                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    365364                  END DO 
    366365               END DO 
    367366            END DO 
    368          ELSE                                       ! runoffs applied at the surface  
    369             nk_rnf(:,:) = 1   
     367         ELSE                                       ! runoffs applied at the surface 
     368            nk_rnf(:,:) = 1 
    370369            h_rnf (:,:) = fse3t(:,:,1) 
    371          ENDIF   
    372          !  
     370         ENDIF 
     371         ! 
    373372      ENDIF 
    374373      ! 
    … …  
    386385         ! 
    387386         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   & 
    388             &                                              'be spread through depth by ln_rnf_depth'               )  
     387            &                                              'be spread through depth by ln_rnf_depth'               ) 
    389388         ! 
    390389         nkrnf = 0                                  ! Number of level over which Kz increase 
    … …  
    406405         IF(lwp) WRITE(numout,*) 
    407406         IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths' 
    408          rnfmsk  (:,:) = 0._wp  
     407         rnfmsk  (:,:) = 0._wp 
    409408         rnfmsk_z(:)   = 0._wp 
    410409         nkrnf = 0 
    … …  
    417416      !!---------------------------------------------------------------------- 
    418417      !!                  ***  ROUTINE rnf_mouth  *** 
    419       !!        
     418      !! 
    420419      !! ** Purpose :   define the river mouths mask 
    421420      !! 
    422421      !! ** Method  :   read the river mouth mask (=0/1) in the river runoff 
    423       !!                climatological file. Defined a given vertical structure.  
    424       !!                CAUTION, the vertical structure is hard coded on the  
     422      !!                climatological file. Defined a given vertical structure. 
     423      !!                CAUTION, the vertical structure is hard coded on the 
    425424      !!                first 5 levels. 
    426425      !!                This fields can be used to: 
    427       !!                 - set an upstream advection scheme   
     426      !!                 - set an upstream advection scheme 
    428427      !!                   (ln_rnf_mouth=T and ln_traadv_cen2=T) 
    429       !!                 - increase vertical on the top nn_krnf vertical levels  
     428      !!                 - increase vertical on the top nn_krnf vertical levels 
    430429      !!                   at river runoff input grid point (nn_krnf>=2, see step.F90) 
    431430      !!                 - set to zero SSS restoring flux at river mouth grid points 
    … …  
    437436      CHARACTER(len=140) ::   cl_rnfile   ! runoff file name 
    438437      !!---------------------------------------------------------------------- 
    439       !  
     438      ! 
    440439      IF(lwp) WRITE(numout,*) 
    441440      IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask' 
    … …  
    454453      IF( nn_closea == 1 )   CALL clo_rnf( rnfmsk )               ! closed sea inflow set as ruver mouth 
    455454      ! 
    456       rnfmsk_z(:)   = 0._wp                                       ! vertical structure  
     455      rnfmsk_z(:)   = 0._wp                                       ! vertical structure 
    457456      rnfmsk_z(1)   = 1.0 
    458457      rnfmsk_z(2)   = 1.0                                         ! ********** 
    … …  
    460459      rnfmsk_z(4)   = 0.25                                        ! ********** 
    461460      rnfmsk_z(5)   = 0.125 
    462       !          
     461      ! 
    463462   END SUBROUTINE rnf_mouth 
    464     
     463 
    465464   !!====================================================================== 
    466465END MODULE sbcrnf 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r3625 r3764  
    2727   PRIVATE 
    2828 
    29    PUBLIC   sbc_ssr    ! routine called in sbcmod 
     29   PUBLIC   sbc_ssr        ! routine called in sbcmod 
     30   PUBLIC   sbc_ssr_init   ! routine called in sbcmod 
    3031 
    3132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s] 
    … …  
    8384      IF( nn_timing == 1 )  CALL timing_start('sbc_ssr') 
    8485      ! 
    85       !                                               ! -------------------- ! 
    86       IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
    87          !                                            ! -------------------- ! 
    88          !                            !* set file information 
    89          cn_dir  = './'            ! directory in which the model is executed 
    90          ! ... default values (NB: frequency positive => hours, negative => months) 
    91          !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    92          !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    93          sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    94          sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
    95  
    96          REWIND ( numnam )            !* read in namlist namflx 
    97          READ( numnam, namsbc_ssr )  
    98  
    99          IF(lwp) THEN                 !* control print 
    100             WRITE(numout,*) 
    101             WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
    102             WRITE(numout,*) '~~~~~~~ ' 
    103             WRITE(numout,*) '   Namelist namsbc_ssr :' 
    104             WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
    105             WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
    106             WRITE(numout,*) '                       (Yes=2, volume flux) ' 
    107             WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
    108             WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
    109             WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    110             WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
    111          ENDIF 
    112  
    113          ! Allocate erp and qrp array 
    114          ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 
    115          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
    116  
    117          IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays 
    118             ! 
    119             ALLOCATE( sf_sst(1), STAT=ierror ) 
    120             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' ) 
    121             ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) 
    122             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' ) 
    123             ! 
    124             ! fill sf_sst with sn_sst and control print 
    125             CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
    126             IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    127             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 
    128             ! 
    129          ENDIF 
    130          ! 
    131          IF( nn_sssr >= 1 ) THEN      ! set sf_sss structure & allocate arrays 
    132             ! 
    133             ALLOCATE( sf_sss(1), STAT=ierror ) 
    134             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 
    135             ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 
    136             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 
    137             ! 
    138             ! fill sf_sss with sn_sss and control print 
    139             CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
    140             IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    141             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 
    142             ! 
    143          ENDIF 
    144          ! 
    145          ! Initialize qrp and erp if no restoring  
    146          IF( nn_sstr /= 1                   )   qrp(:,:) = 0.e0  
    147          IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0.e0  
    148       ENDIF 
    149  
    15086      IF( nn_sstr + nn_sssr /= 0 ) THEN 
    15187         ! 
    … …  
    207143      ! 
    208144   END SUBROUTINE sbc_ssr 
     145 
     146  
     147   SUBROUTINE sbc_ssr_init 
     148      !!--------------------------------------------------------------------- 
     149      !!                  ***  ROUTINE sbc_ssr_init  *** 
     150      !! 
     151      !! ** Purpose :   initialisation of surface damping term 
     152      !! 
     153      !! ** Method  : - Read namelist namsbc_ssr 
     154      !!              - Read observed SST and/or SSS if required 
     155      !!--------------------------------------------------------------------- 
     156      INTEGER  ::   ji, jj   ! dummy loop indices 
     157      REAL(wp) ::   zerp     ! local scalar for evaporation damping 
     158      REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
     159      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
     160      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
     161      INTEGER  ::   ierror   ! return error code 
     162      !! 
     163      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     164      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
     165      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     166      !!---------------------------------------------------------------------- 
     167      ! 
     168      !                            !* set file information 
     169      cn_dir  = './'            ! directory in which the model is executed 
     170      ! ... default values (NB: frequency positive => hours, negative => months) 
     171      !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     172      !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     173      sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
     174      sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
     175 
     176      REWIND( numnam )             !* read in namlist namflx 
     177      READ  ( numnam, namsbc_ssr )  
     178 
     179      IF(lwp) THEN                 !* control print 
     180         WRITE(numout,*) 
     181         WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
     182         WRITE(numout,*) '~~~~~~~ ' 
     183         WRITE(numout,*) '   Namelist namsbc_ssr :' 
     184         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
     185         WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
     186         WRITE(numout,*) '                       (Yes=2, volume flux) ' 
     187         WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
     188         WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
     189         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
     190         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
     191      ENDIF 
     192      ! 
     193      !                            !* Allocate erp and qrp array 
     194      ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 
     195      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
     196      ! 
     197      IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays 
     198         ! 
     199         ALLOCATE( sf_sst(1), STAT=ierror ) 
     200         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' ) 
     201         ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) 
     202         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' ) 
     203         ! 
     204         ! fill sf_sst with sn_sst and control print 
     205         CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
     206         IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
     207         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 
     208         ! 
     209      ENDIF 
     210      ! 
     211      IF( nn_sssr >= 1 ) THEN      !* set sf_sss structure & allocate arrays 
     212         ! 
     213         ALLOCATE( sf_sss(1), STAT=ierror ) 
     214         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 
     215         ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 
     216         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 
     217         ! 
     218         ! fill sf_sss with sn_sss and control print 
     219         CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
     220         IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
     221         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 
     222         ! 
     223      ENDIF 
     224      ! 
     225      !                            !* Initialize qrp and erp if no restoring  
     226      IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp 
     227      IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp 
     228      ! 
     229   END SUBROUTINE sbc_ssr_init 
    209230       
    210231   !!====================================================================== 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90

    r3294 r3764  
    8383 
    8484      !                              ! allocate solver arrays 
    85       IF( sol_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'solver_init : unable to allocate sol_oce arrays' ) 
     85      IF( .NOT. lk_agrif .OR. .NOT. ln_rstart) THEN 
     86         IF( sol_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'solver_init : unable to allocate sol_oce arrays' ) 
     87      ENDIF 
    8688 
    8789      SELECT CASE( nn_solv )          !* parameter check 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r3294 r3764  
    88   !!   NEMO     1.0  ! 2002-08  (G. Madec)  free form + modules 
    99   !!             -   ! 2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl 
    10    !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization  
    11    !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl  
     10   !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
     11   !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl 
    1212   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC 
    1313   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    … …  
    3030   USE trdmod_oce     ! trends: ocean variables 
    3131   USE trdtra         ! trends: active tracers 
    32    USE iom            ! IOM server                
     32   USE iom            ! IOM server 
    3333   USE in_out_manager ! I/O manager 
    3434   USE lbclnk         ! ocean lateral boundary conditions 
    … …  
    4949   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag 
    5050 
    51    !                                           !!* Namelist nambbl *  
     51   !                                           !!* Namelist nambbl * 
    5252   INTEGER , PUBLIC ::   nn_bbl_ldf = 0         !: =1   : diffusive bbl or not (=0) 
    5353   INTEGER , PUBLIC ::   nn_bbl_adv = 0         !: =1/2 : advective bbl or not (=0) 
    … …  
    5858 
    5959   LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport 
    60     
     60 
    6161   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
    6262   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts 
    6363 
    64    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level 
    65    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction 
    66    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
    67    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points 
    68    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2] 
     64   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level (PUBLIC for TAM) 
     65   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM) 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
     67   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM) 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2] (PUBLIC for TAM) 
    6969 
    7070   !! * Substitutions 
    … …  
    9595      !!---------------------------------------------------------------------- 
    9696      !!                  ***  ROUTINE bbl  *** 
    97       !!                    
    98       !! ** Purpose :   Compute the before tracer (t & s) trend associated  
     97      !! 
     98      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
    9999      !!              with the bottom boundary layer and add it to the general 
    100100      !!              trend of tracer equations. 
    … …  
    103103      !!              diffusive and/or advective contribution to the tracer trend 
    104104      !!              is added to the general tracer trend 
    105       !!----------------------------------------------------------------------   
    106       INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
     105      !!---------------------------------------------------------------------- 
     106      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    107107      !! 
    108108      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    … …  
    112112      ! 
    113113      IF( l_trdtra )   THEN                        !* Save ta and sa trends 
    114          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
    115          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
     114         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     115         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    116116         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    117117      ENDIF 
    118118 
    119119      IF( l_bbl )  CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
    120   
     120 
    121121      IF( nn_bbl_ldf == 1 ) THEN                   !* Diffusive bbl 
    122122         ! 
    … …  
    125125         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    126126         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    127          ! lateral boundary conditions ; just need for outputs                           
     127         ! lateral boundary conditions ; just need for outputs 
    128128         CALL lbc_lnk( ahu_bbl, 'U', 1. )     ;     CALL lbc_lnk( ahv_bbl, 'V', 1. ) 
    129          CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef      
     129         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    130130         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
    131131         ! 
    … …  
    138138         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
    139139         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    140          ! lateral boundary conditions ; just need for outputs                           
     140         ! lateral boundary conditions ; just need for outputs 
    141141         CALL lbc_lnk( utr_bbl, 'U', 1. )     ;   CALL lbc_lnk( vtr_bbl, 'V', 1. ) 
    142          CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport      
     142         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    143143         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    144144         ! 
    … …  
    150150         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt ) 
    151151         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds ) 
    152          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
     152         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    153153      ENDIF 
    154154      ! 
    … …  
    161161      !!---------------------------------------------------------------------- 
    162162      !!                  ***  ROUTINE tra_bbl_dif  *** 
    163       !!                    
     163      !! 
    164164      !! ** Purpose :   Computes the bottom boundary horizontal and vertical 
    165       !!                advection terms.  
    166       !! 
    167       !! ** Method  :    
     165      !!                advection terms. 
     166      !! 
     167      !! ** Method  : 
    168168      !!        * diffusive bbl (nn_bbl_ldf=1) : 
    169169      !!        When the product grad( rho) * grad(h) < 0 (where grad is an 
    … …  
    179179      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    180180      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    181       !!----------------------------------------------------------------------   
     181      !!---------------------------------------------------------------------- 
    182182      ! 
    183183      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    184184      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    185       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend  
     185      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
    186186      ! 
    187187      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    … …  
    202202#else 
    203203         DO jj = 1, jpj 
    204             DO ji = 1, jpi  
     204            DO ji = 1, jpi 
    205205#endif 
    206206               ik = mbkt(ji,jj)                        ! bottom T-level index 
    … …  
    233233      ! 
    234234   END SUBROUTINE tra_bbl_dif 
    235     
     235 
    236236 
    237237   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) 
    … …  
    239239      !!                  ***  ROUTINE trc_bbl  *** 
    240240      !! 
    241       !! ** Purpose :   Compute the before passive tracer trend associated  
     241      !! ** Purpose :   Compute the before passive tracer trend associated 
    242242      !!     with the bottom boundary layer and add it to the general trend 
    243243      !!     of tracer equations. 
    244244      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) : 
    245245      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity 
    246       !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e.  
    247       !!                       transport proportional to the along-slope density gradient                    
     246      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e. 
     247      !!                       transport proportional to the along-slope density gradient 
    248248      !! 
    249249      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    250250      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    251       !!----------------------------------------------------------------------   
     251      !!---------------------------------------------------------------------- 
    252252      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    253253      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    254       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend  
     254      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
    255255      ! 
    256256      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    … …  
    264264      !                                                          ! =========== 
    265265      DO jn = 1, kjpt                                            ! tracer loop 
    266          !                                                       ! ===========          
     266         !                                                       ! =========== 
    267267# if defined key_vectopt_loop 
    268268         DO jj = 1, 1 
    … …  
    282282                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    283283                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    284                   !                    
     284                  ! 
    285285                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    286286                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 
    … …  
    288288                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    289289                  END DO 
    290                   !  
     290                  ! 
    291291                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 
    292292                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    … …  
    299299                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj) 
    300300                  zv_bbl = ABS( vtr_bbl(ji,jj) ) 
    301                   !  
     301                  ! 
    302302                  ! up  -slope T-point (shelf bottom point) 
    303303                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 
    304304                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    305305                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    306                   !                    
     306                  ! 
    307307                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    308308                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 
    … …  
    330330      !!---------------------------------------------------------------------- 
    331331      !!                  ***  ROUTINE bbl  *** 
    332       !!                    
     332      !! 
    333333      !! ** Purpose :   Computes the bottom boundary horizontal and vertical 
    334       !!                advection terms.  
    335       !! 
    336       !! ** Method  :    
     334      !!                advection terms. 
     335      !! 
     336      !! ** Method  : 
    337337      !!        * diffusive bbl (nn_bbl_ldf=1) : 
    338338      !!        When the product grad( rho) * grad(h) < 0 (where grad is an 
    … …  
    353353      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    354354      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    355       !!----------------------------------------------------------------------   
     355      !!---------------------------------------------------------------------- 
    356356      ! 
    357357      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    … …  
    399399                                          - 0.121555e-07 ) * pfh 
    400400      !!---------------------------------------------------------------------- 
    401        
     401 
    402402      ! 
    403403      IF( nn_timing == 1 )  CALL timing_start( 'bbl') 
    404404      ! 
    405       CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep )  
    406       ! 
    407       
     405      CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
     406      ! 
     407 
    408408      IF( kt == kit000 )  THEN 
    409409         IF(lwp)  WRITE(numout,*) 
    … …  
    411411         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~' 
    412412      ENDIF 
    413        
     413 
    414414      !                                        !* bottom temperature, salinity, velocity and depth 
    415415#if defined key_vectopt_loop 
    … …  
    426426            ! 
    427427            zub(ji,jj) = un(ji,jj,mbku(ji,jj))      ! bottom velocity 
    428             zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj))  
     428            zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
    429429         END DO 
    430430      END DO 
    431        
     431 
    432432      !                                   !-------------------! 
    433433      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    434434         !                                !-------------------! 
    435435         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    436             DO ji = 1, jpim1               
    437                !                                                ! i-direction  
     436            DO ji = 1, jpim1 
     437               !                                                ! i-direction 
    438438               zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth 
    439439               zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 
    … …  
    442442               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    & 
    443443                  &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1) 
    444                !                                                      
     444               ! 
    445445               zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
    446446               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff. 
    447447               ! 
    448                !                                                ! j-direction  
     448               !                                                ! j-direction 
    449449               zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth 
    450450               zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0 
    … …  
    453453               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    & 
    454454                  &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1) 
    455                !                                                     
     455               ! 
    456456               zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
    457457               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
    … …  
    475475                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    476476                  !                                                           ! masked bbl i-gradient of density 
    477                   zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &   
     477                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    & 
    478478                     &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1) 
    479                   !                                                          
     479                  ! 
    480480                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope 
    481481                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope 
    … …  
    489489                  zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    490490                  !                                                           ! masked bbl j-gradient of density 
    491                   zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &   
     491                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    & 
    492492                     &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1) 
    493493                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope 
    … …  
    513513                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    514514                  zgdrho =    fsbeta( zt, zs, zh )                                    & 
    515                      &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    &   
     515                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    & 
    516516                     &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask(ji,jj,1) 
    517517                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep 
    … …  
    530530                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) ) 
    531531                  zgdrho =    fsbeta( zt, zs, zh )                                    & 
    532                      &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    &   
     532                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    & 
    533533                     &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask(ji,jj,1) 
    534534                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep 
    … …  
    542542      ENDIF 
    543543      ! 
    544       CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep )  
     544      CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
    545545      ! 
    546546      IF( nn_timing == 1 )  CALL timing_stop( 'bbl') 
    … …  
    567567      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init') 
    568568      ! 
    569       CALL wrk_alloc( jpi, jpj, zmbk )  
     569      CALL wrk_alloc( jpi, jpj, zmbk ) 
    570570      ! 
    571571 
    … …  
    588588      !                              ! allocate trabbl arrays 
    589589      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 
    590       
     590 
    591591      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity' 
    592592      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
    … …  
    597597      !                             !* inverse of surface of T-cells 
    598598      r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) ) 
    599        
     599 
    600600      !                             !* vertical index of  "deep" bottom u- and v-points 
    601601      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv) 
    … …  
    605605         END DO 
    606606      END DO 
    607       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
     607      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    608608      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    609609      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    … …  
    611611                                        !* sign of grad(H) at u- and v-points 
    612612      mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0. 
    613       DO jj = 1, jpjm1                 
     613      DO jj = 1, jpjm1 
    614614         DO ji = 1, jpim1 
    615615            mgrhu(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    … …  
    618618      END DO 
    619619 
    620       DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point  
     620      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    621621         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    622             e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) )   
    623             e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) )   
    624          END DO  
     622            e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) ) 
     623            e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) ) 
     624         END DO 
    625625      END DO 
    626626      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions 
    627627 
    628       !                             !* masked diffusive flux coefficients  
     628      !                             !* masked diffusive flux coefficients 
    629629      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1) 
    630630      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1) 
    … …  
    636636         CASE ( 2 )                          ! ORCA_R2 
    637637            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL 
    638             ii0 = 139   ;   ii1 = 140   
     638            ii0 = 139   ;   ii1 = 140 
    639639            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    640640            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    … …  
    647647         CASE ( 4 )                          ! ORCA_R4 
    648648            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL 
    649             ii0 =  70   ;   ii1 =  71   
     649            ii0 =  70   ;   ii1 =  71 
    650650            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    651651            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    … …  
    654654      ENDIF 
    655655      ! 
    656       CALL wrk_dealloc( jpi, jpj, zmbk )  
     656      CALL wrk_dealloc( jpi, jpj, zmbk ) 
    657657      ! 
    658658      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init') 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3680 r3764  
    209209      !---------------------------------------- 
    210210      ! 
    211       zfact = 0.5e0 
    212  
    213       ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection)  
    214       IF( ln_rnf ) THEN   
     211      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff  
     212         zfact = 0.5_wp 
    215213         DO jj = 2, jpj  
    216214            DO ji = fs_2, fs_jpim1 
    217                zdep = 1. / h_rnf(ji,jj) 
    218                zdep = zfact * zdep   
    219                IF ( rnf(ji,jj) /= 0._wp ) THEN 
     215               IF( rnf(ji,jj) /= 0._wp ) THEN 
     216                  zdep = zfact / h_rnf(ji,jj) 
    220217                  DO jk = 1, nk_rnf(ji,jj) 
    221218                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
    … …  
    227224            END DO   
    228225         END DO   
    229       ENDIF   
    230 !!gm  It should be useless 
    231       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )    ;    CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    232  
     226      ENDIF 
     227  
    233228      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    234229         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r3633 r3764  
    1818   !!---------------------------------------------------------------------- 
    1919   USE oce             ! ocean dynamics and tracers variables 
    20    USE dom_oce         ! ocean space and time domain variables  
     20   USE dom_oce         ! ocean space and time domain variables 
    2121   USE zdf_oce         ! ocean vertical physics variables 
    2222   USE in_out_manager  ! I/O manager 
    … …  
    3535 
    3636   !                                    !!* Namelist nambfr: bottom friction namelist * 
    37    INTEGER  ::   nn_bfr      = 0           ! = 0/1/2/3 type of bottom friction  
    38    REAL(wp) ::   rn_bfri1    = 4.0e-4_wp   ! bottom drag coefficient (linear case)  
    39    REAL(wp) ::   rn_bfri2    = 1.0e-3_wp   ! bottom drag coefficient (non linear case) 
    40    REAL(wp) ::   rn_bfeb2    = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2] 
    41    REAL(wp) ::   rn_bfrien   = 30._wp      ! local factor to enhance coefficient bfri 
    42    LOGICAL  ::   ln_bfr2d    = .false.     ! logical switch for 2D enhancement 
    43    LOGICAL  ::   ln_loglayer = .false.     ! switch for log layer bfr coeff. 
    44    REAL(wp) ::   rn_bfrz0    = 0.003_wp    ! bottom roughness for loglayer bfr coeff 
    45    LOGICAL , PUBLIC                            ::  ln_bfrimp   = .false.  ! switch for implicit bottom friction 
    46    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  bfrcoef2d              ! 2D bottom drag coefficient 
     37   INTEGER , PUBLIC ::   nn_bfr      = 0           ! = 0/1/2/3 type of bottom friction  (PUBLIC for TAM) 
     38   REAL(wp), PUBLIC ::   rn_bfri1    = 4.0e-4_wp   ! bottom drag coefficient (linear case)  (PUBLIC for TAM) 
     39   REAL(wp), PUBLIC ::   rn_bfri2    = 1.0e-3_wp   ! bottom drag coefficient (non linear case) (PUBLIC for TAM) 
     40   REAL(wp), PUBLIC ::   rn_bfeb2    = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2] (PUBLIC for TAM) 
     41   REAL(wp), PUBLIC ::   rn_bfrien   = 30._wp      ! local factor to enhance coefficient bfri (PUBLIC for TAM) 
     42   LOGICAL , PUBLIC ::   ln_bfr2d    = .false.     ! logical switch for 2D enhancement (PUBLIC for TAM) 
     43   LOGICAL , PUBLIC ::   ln_loglayer = .false.     ! switch for log layer bfr coeff. (PUBLIC for TAM) 
     44   REAL(wp), PUBLIC ::   rn_bfrz0    = 0.003_wp    ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM) 
     45   LOGICAL , PUBLIC                                    ::  ln_bfrimp = .false.  ! logical switch for implicit bottom friction 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d            ! 2D bottom drag coefficient (PUBLIC for TAM) 
    4747 
    4848   !! * Substitutions 
    … …  
    7070      !!---------------------------------------------------------------------- 
    7171      !!                   ***  ROUTINE zdf_bfr  *** 
    72       !!                  
     72      !! 
    7373      !! ** Purpose :   compute the bottom friction coefficient. 
    7474      !! 
    75       !! ** Method  :   Calculate and store part of the momentum trend due     
    76       !!              to bottom friction following the chosen friction type  
     75      !! ** Method  :   Calculate and store part of the momentum trend due 
     76      !!              to bottom friction following the chosen friction type 
    7777      !!              (free-slip, linear, or quadratic). The component 
    7878      !!              calculated here is multiplied by the bottom velocity in 
    … …  
    124124            DO ji = 2, jpim1 
    125125# endif 
    126                ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
     126               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    127127               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    128128               ! 
    … …  
    135135               zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2  ) 
    136136               ! 
    137                bfrua(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu  
     137               bfrua(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu 
    138138               bfrva(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji  ,jj+1) ) * zecv 
    139139            END DO 
    … …  
    156156      !!---------------------------------------------------------------------- 
    157157      !!                  ***  ROUTINE zdf_bfr_init  *** 
    158       !!                     
     158      !! 
    159159      !! ** Purpose :   Initialization of the bottom friction 
    160160      !! 
    … …  
    217217         bfrcoef2d(:,:) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable 
    218218         ! 
    219          IF(ln_bfr2d) THEN  
     219         IF(ln_bfr2d) THEN 
    220220            ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 
    221221            CALL iom_open('bfr_coef.nc',inum) 
    … …  
    238238 
    239239         ! 
    240          IF(ln_bfr2d) THEN  
     240         IF(ln_bfr2d) THEN 
    241241            ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 
    242242            CALL iom_open('bfr_coef.nc',inum) 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r3625 r3764  
    247247#if defined key_zdfddm 
    248248      REAL(wp) ::   zrrau, zds, zavdds, zavddt,zinr   ! double diffusion mixing 
    249       REAL(wp), POINTER, DIMENSION(:,:) ::     zdifs 
    250       REAL(wp), POINTER, DIMENSION(:)   ::   za2s, za3s, zkmps 
     249      REAL(wp), POINTER, DIMENSION(:,:)   ::     zdifs 
     250      REAL(wp), POINTER, DIMENSION(:)     ::   za2s, za3s, zkmps 
    251251      REAL(wp) ::                            zkm1s 
    252       REAL(wp), POINTER, DIMENSION(:,:) ::   zblcs 
     252      REAL(wp), POINTER, DIMENSION(:,:)   ::   zblcs 
    253253      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdiffus 
    254254#endif 
    … …  
    266266      CALL wrk_alloc( jpi,4, zdepw, zdift, zvisc ) 
    267267      CALL wrk_alloc( jpi,jpj, zBo, zBosol, zustar ) 
    268       CALL wrk_alloc( jpi,jpk, zmask, zblcm, zblct, zblcs ) 
     268      CALL wrk_alloc( jpi,jpk, zmask, zblcm, zblct ) 
    269269#if defined key_zdfddm 
    270270      CALL wrk_alloc( jpi,4, zdifs ) 
    … …  
    10811081               zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) * tmask(ji,jj,jk)  
    10821082#if defined key_zdfddm 
    1083                zdiffus(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )          * avs (ji,jj,jk) & ! interior diffusivities  
     1083               zdiffus(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )         * avs (ji,jj,jk) & ! interior diffusivities  
    10841084                  &              +                        zflag   * zblcs(ji,jk   ) & ! boundary layer diffusivities 
    10851085                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmps(ji      )   ! diffusivity enhancement at W_level near zhbl 
    1086                         
    10871086               zdiffus(ji,jj,jk) = zdiffus(ji,jj,jk) * tmask(ji,jj,jk)  
    10881087#endif                
    … …  
    12121211      CALL wrk_dealloc( jpi,4, zdepw, zdift, zvisc ) 
    12131212      CALL wrk_dealloc( jpi,jpj, zBo, zBosol, zustar ) 
    1214       CALL wrk_dealloc( jpi,jpk, zmask, zblcm, zblct, zblcs ) 
     1213      CALL wrk_dealloc( jpi,jpk, zmask, zblcm, zblct ) 
    12151214#if defined key_zdfddm 
    12161215      CALL wrk_dealloc( jpi,4, zdifs ) 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r3632 r3764  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   glob_sum    : generic interface for global masked summation over  
     10   !!   glob_sum    : generic interface for global masked summation over 
    1111   !!                 the interior domain for 1 or 2 2D or 3D arrays 
    12    !!                 it works only for T points    
     12   !!                 it works only for T points 
    1313   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour 
    1414   !!                 of intrinsinc sign function 
    … …  
    2929 
    3030   INTERFACE glob_sum 
    31       MODULE PROCEDURE glob_sum_2d, glob_sum_3d,glob_sum_2d_a, glob_sum_3d_a  
     31      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, & 
     32         &             glob_sum_2d_a, glob_sum_3d_a 
    3233   END INTERFACE 
    3334 
    34 #if defined key_nosignedzero    
     35#if defined key_nosignedzero 
    3536   INTERFACE SIGN 
    3637      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   & 
    37          &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          &  
    38          &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B  
     38         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          & 
     39         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B 
    3940   END INTERFACE 
    4041#endif 
    … …  
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    44    !! $Id$  
     45   !! $Id$ 
    4546   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4647   !!---------------------------------------------------------------------- 
    47 CONTAINS  
     48CONTAINS 
    4849 
    4950#if ! defined key_mpp_rep 
    50  
    51    FUNCTION glob_sum_2d( ptab )  
     51   FUNCTION glob_sum_1d( ptab, kdim ) 
     52      !!----------------------------------------------------------------------- 
     53      !!                  ***  FUNCTION  glob_sum_1D  *** 
     54      !! 
     55      !! ** Purpose : perform a masked sum on the inner global domain of a 1D array 
     56      !!----------------------------------------------------------------------- 
     57      INTEGER :: kdim 
     58      REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab        ! input 1D array 
     59      REAL(wp)                              ::   glob_sum_1d ! global sum 
     60      !!----------------------------------------------------------------------- 
     61      ! 
     62      glob_sum_1d = SUM( ptab(:) ) 
     63      IF( lk_mpp )   CALL mpp_sum( glob_sum_1d ) 
     64      ! 
     65   END FUNCTION glob_sum_1d 
     66 
     67   FUNCTION glob_sum_2d( ptab ) 
    5268      !!----------------------------------------------------------------------- 
    5369      !!                  ***  FUNCTION  glob_sum_2D  *** 
    … …  
    6379      ! 
    6480   END FUNCTION glob_sum_2d 
    65     
    66     
    67    FUNCTION glob_sum_3d( ptab )  
     81 
     82 
     83   FUNCTION glob_sum_3d( ptab ) 
    6884      !!----------------------------------------------------------------------- 
    6985      !!                  ***  FUNCTION  glob_sum_3D  *** 
    … …  
    86102 
    87103 
    88    FUNCTION glob_sum_2d_a( ptab1, ptab2 )  
     104   FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 
    89105      !!----------------------------------------------------------------------- 
    90106      !!                  ***  FUNCTION  glob_sum_2D _a *** 
    … …  
    95111      REAL(wp)            , DIMENSION(2)   ::   glob_sum_2d_a   ! global masked sum 
    96112      !!----------------------------------------------------------------------- 
    97       !              
     113      ! 
    98114      glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) ) 
    99115      glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) ) 
    … …  
    101117      ! 
    102118   END FUNCTION glob_sum_2d_a 
    103   
    104   
    105    FUNCTION glob_sum_3d_a( ptab1, ptab2 )  
     119 
     120 
     121   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
    106122      !!----------------------------------------------------------------------- 
    107123      !!                  ***  FUNCTION  glob_sum_3D_a *** 
    … …  
    124140   END FUNCTION glob_sum_3d_a 
    125141 
    126 #else   
     142#else 
    127143   !!---------------------------------------------------------------------- 
    128144   !!   'key_mpp_rep'                                   MPP reproducibility 
    129145   !!---------------------------------------------------------------------- 
    130     
    131    FUNCTION glob_sum_2d( ptab )  
     146 
     147   FUNCTION glob_sum_1d( ptab, kdim ) 
     148      !!---------------------------------------------------------------------- 
     149      !!                  ***  FUNCTION  glob_sum_1d *** 
     150      !! 
     151      !! ** Purpose : perform a sum in calling DDPDD routine 
     152      !!---------------------------------------------------------------------- 
     153      INTEGER , INTENT(in) :: kdim 
     154      REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab 
     155      REAL(wp)                              ::   glob_sum_1d   ! global sum 
     156      !! 
     157      COMPLEX(wp)::   ctmp 
     158      REAL(wp)   ::   ztmp 
     159      INTEGER    ::   ji   ! dummy loop indices 
     160      !!----------------------------------------------------------------------- 
     161      ! 
     162      ztmp = 0.e0 
     163      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     164      DO ji = 1, kdim 
     165         ztmp =  ptab(ji) 
     166         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     167         END DO 
     168      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
     169      glob_sum_1d = REAL(ctmp,wp) 
     170      ! 
     171   END FUNCTION glob_sum_1d 
     172 
     173   FUNCTION glob_sum_2d( ptab ) 
    132174      !!---------------------------------------------------------------------- 
    133175      !!                  ***  FUNCTION  glob_sum_2d *** 
    … …  
    154196      glob_sum_2d = REAL(ctmp,wp) 
    155197      ! 
    156    END FUNCTION glob_sum_2d    
    157  
    158  
    159    FUNCTION glob_sum_3d( ptab )  
     198   END FUNCTION glob_sum_2d 
     199 
     200 
     201   FUNCTION glob_sum_3d( ptab ) 
    160202      !!---------------------------------------------------------------------- 
    161203      !!                  ***  FUNCTION  glob_sum_3d *** 
    … …  
    179221            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    180222            END DO 
    181          END DO     
     223         END DO 
    182224      END DO 
    183225      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    184226      glob_sum_3d = REAL(ctmp,wp) 
    185227      ! 
    186    END FUNCTION glob_sum_3d    
    187  
    188  
    189    FUNCTION glob_sum_2d_a( ptab1, ptab2 )  
     228   END FUNCTION glob_sum_3d 
     229 
     230 
     231   FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 
    190232      !!---------------------------------------------------------------------- 
    191233      !!                  ***  FUNCTION  glob_sum_2d_a *** 
    … …  
    214256      glob_sum_2d_a = REAL(ctmp,wp) 
    215257      ! 
    216    END FUNCTION glob_sum_2d_a    
    217  
    218  
    219    FUNCTION glob_sum_3d_a( ptab1, ptab2 )  
     258   END FUNCTION glob_sum_2d_a 
     259 
     260 
     261   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
    220262      !!---------------------------------------------------------------------- 
    221263      !!                  ***  FUNCTION  glob_sum_3d_a *** 
    … …  
    241283            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    242284            END DO 
    243          END DO     
     285         END DO 
    244286      END DO 
    245287      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    246288      glob_sum_3d_a = REAL(ctmp,wp) 
    247289      ! 
    248    END FUNCTION glob_sum_3d_a    
     290   END FUNCTION glob_sum_3d_a 
    249291 
    250292#endif 
    … …  
    253295      !!---------------------------------------------------------------------- 
    254296      !!               ***  ROUTINE DDPDD *** 
    255       !!           
     297      !! 
    256298      !! ** Purpose : Add a scalar element to a sum 
    257       !!              
    258       !! 
    259       !! ** Method  : The code uses the compensated summation with doublet  
     299      !! 
     300      !! 
     301      !! ** Method  : The code uses the compensated summation with doublet 
    260302      !!              (sum,error) emulated useing complex numbers. ydda is the 
    261       !!               scalar to add to the summ yddb  
    262       !!  
    263       !! ** Action  : This does only work for MPI.  
     303      !!               scalar to add to the summ yddb 
     304      !! 
     305      !! ** Action  : This does only work for MPI. 
    264306      !! 
    265307      !! References : Using Acurate Arithmetics to Improve Numerical 
    266308      !!              Reproducibility and Sability in Parallel Applications 
    267       !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001  
     309      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001 
    268310      !!---------------------------------------------------------------------- 
    269311      COMPLEX(wp), INTENT(in   ) ::   ydda 
    … …  
    288330   !!   'key_nosignedzero'                                         F90 SIGN 
    289331   !!---------------------------------------------------------------------- 
    290     
     332 
    291333   FUNCTION SIGN_SCALAR( pa, pb ) 
    292334      !!----------------------------------------------------------------------- 
    … …  
    304346 
    305347 
    306    FUNCTION SIGN_ARRAY_1D( pa, pb )  
     348   FUNCTION SIGN_ARRAY_1D( pa, pb ) 
    307349      !!----------------------------------------------------------------------- 
    308350      !!                  ***  FUNCTION SIGN_ARRAY_1D  *** 
    … …  
    319361 
    320362 
    321    FUNCTION SIGN_ARRAY_2D(pa,pb)  
     363   FUNCTION SIGN_ARRAY_2D(pa,pb) 
    322364      !!----------------------------------------------------------------------- 
    323365      !!                  ***  FUNCTION SIGN_ARRAY_2D  *** 
    … …  
    333375   END FUNCTION SIGN_ARRAY_2D 
    334376 
    335    FUNCTION SIGN_ARRAY_3D(pa,pb)  
     377   FUNCTION SIGN_ARRAY_3D(pa,pb) 
    336378      !!----------------------------------------------------------------------- 
    337379      !!                  ***  FUNCTION SIGN_ARRAY_3D  *** 
    … …  
    348390 
    349391 
    350    FUNCTION SIGN_ARRAY_1D_A(pa,pb)  
     392   FUNCTION SIGN_ARRAY_1D_A(pa,pb) 
    351393      !!----------------------------------------------------------------------- 
    352394      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  *** 
    … …  
    363405 
    364406 
    365    FUNCTION SIGN_ARRAY_2D_A(pa,pb)  
     407   FUNCTION SIGN_ARRAY_2D_A(pa,pb) 
    366408      !!----------------------------------------------------------------------- 
    367409      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  *** 
    … …  
    378420 
    379421 
    380    FUNCTION SIGN_ARRAY_3D_A(pa,pb)  
     422   FUNCTION SIGN_ARRAY_3D_A(pa,pb) 
    381423      !!----------------------------------------------------------------------- 
    382424      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  *** 
    … …  
    393435 
    394436 
    395    FUNCTION SIGN_ARRAY_1D_B(pa,pb)  
     437   FUNCTION SIGN_ARRAY_1D_B(pa,pb) 
    396438      !!----------------------------------------------------------------------- 
    397439      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  *** 
    … …  
    408450 
    409451 
    410    FUNCTION SIGN_ARRAY_2D_B(pa,pb)  
     452   FUNCTION SIGN_ARRAY_2D_B(pa,pb) 
    411453      !!----------------------------------------------------------------------- 
    412454      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  *** 
    … …  
    423465 
    424466 
    425    FUNCTION SIGN_ARRAY_3D_B(pa,pb)  
     467   FUNCTION SIGN_ARRAY_3D_B(pa,pb) 
    426468      !!----------------------------------------------------------------------- 
    427469      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  *** 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3701 r3764  
    66   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    77   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1  
     8   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
     9   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
    1010   !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice  
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
     11   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
     12   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    1313   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    1414   !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model  
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP  
     15   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
     16   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
    1717   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    1818   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    … …  
    2525   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    2626   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface  
     27   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    2828   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2929   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    … …  
    3434   !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
    3535   !!   nemo_init      : initialization of the NEMO system 
    36    !!   nemo_ctl       : initialisation of the contol print  
     36   !!   nemo_ctl       : initialisation of the contol print 
    3737   !!   nemo_closefile : close remaining open files 
    3838   !!   nemo_alloc     : dynamical allocation 
    … …  
    6464   USE diadct          ! sections transports           (dia_dct_init routine) 
    6565   USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
     66   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    6667   USE step            ! NEMO time-stepping                 (stp     routine) 
    6768   USE icbini          ! handle bergs, initialisation 
    … …  
    8384   USE sbctide, ONLY: lk_tide 
    8485 
    85  
    8686   IMPLICIT NONE 
    8787   PRIVATE 
    … …  
    8989   PUBLIC   nemo_gcm    ! called by model.F90 
    9090   PUBLIC   nemo_init   ! needed by AGRIF 
     91   PUBLIC   nemo_alloc  ! needed by TAM 
    9192 
    9293   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    … …  
    103104      !!                     ***  ROUTINE nemo_gcm  *** 
    104105      !! 
    105       !! ** Purpose :   NEMO solves the primitive equations on an orthogonal  
     106      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal 
    106107      !!              curvilinear mesh on the sphere. 
    107108      !! 
    … …  
    151152          IF( lk_asminc ) THEN 
    152153             IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 )    ! Output background fields 
    153              IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 )    ! Output trajectory fields 
    154154             IF( ln_asmdin ) THEN                        ! Direct initialization 
    155155                IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 )    ! Tracers 
    156                 IF( ln_dyninc ) THEN  
    157                    CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics 
    158                    IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 )      ! update vertical velocity  
    159                 ENDIF 
     156                IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics 
    160157                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH 
    161158             ENDIF 
    162159          ENDIF 
    163          
     160 
    164161         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    165162#if defined key_agrif 
    … …  
    176173      ! 
    177174      IF( ln_icebergs )   CALL icb_end( nitend ) 
    178         
     175 
    179176      !                            !------------------------! 
    180177      !                            !==  finalize the run  ==! 
    … …  
    184181      IF( nstop /= 0 .AND. lwp ) THEN   ! error print 
    185182         WRITE(numout,cform_err) 
    186          WRITE(numout,*) nstop, ' error have been found'  
     183         WRITE(numout,*) nstop, ' error have been found' 
    187184      ENDIF 
    188185      ! 
    … …  
    261258      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    262259 
    263       ! If dimensions of processor grid weren't specified in the namelist file  
     260      ! If dimensions of processor grid weren't specified in the namelist file 
    264261      ! then we calculate them here now that we have our communicator size 
    265262      IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
    … …  
    302299         WRITE(numout,*) 
    303300         WRITE(numout,*) 
    304          DO ji = 1, SIZE(cltxt)  
     301         DO ji = 1, SIZE(cltxt) 
    305302            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
    306303         END DO 
    … …  
    309306      ENDIF 
    310307 
    311       ! Now we know the dimensions of the grid and numout has been set we can  
     308      ! Now we know the dimensions of the grid and numout has been set we can 
    312309      ! allocate arrays 
    313310      CALL nemo_alloc() 
    … …  
    336333      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    337334 
    338       IF( lk_obc        )   CALL     obc_init   ! Open boundaries  
     335      IF( lk_obc        )   CALL     obc_init   ! Open boundaries 
    339336 
    340337                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    … …  
    349346 
    350347      !                                     ! Ocean physics 
    351                             CALL     sbc_init   ! Forcings : surface module  
     348                            CALL     sbc_init   ! Forcings : surface module 
    352349      !                                         ! Vertical physics 
    353350                            CALL     zdf_init      ! namelist read 
    … …  
    358355      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme 
    359356      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing 
    360       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &  
     357      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    361358         &                  CALL zdf_ddm_init      ! double diffusive mixing 
    362359      !                                         ! Lateral physics 
    … …  
    381378                            CALL dyn_zdf_init   ! vertical diffusion 
    382379                            CALL dyn_spg_init   ! surface pressure gradient 
    383                              
     380 
    384381      !                                     ! Misc. options 
    385382      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection 
    … …  
    401398                            CALL dia_obs_init            ! Initialize observational data 
    402399                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    403       ENDIF       
     400      ENDIF 
    404401      !                                     ! Assimilation increments 
    405402      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    … …  
    413410      !!                     ***  ROUTINE nemo_ctl  *** 
    414411      !! 
    415       !! ** Purpose :   control print setting  
     412      !! ** Purpose :   control print setting 
    416413      !! 
    417414      !! ** Method  : - print namctl information and check some consistencies 
    … …  
    460457         !                              ! indices used for the SUM control 
    461458         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    462             lsp_area = .FALSE.                         
     459            lsp_area = .FALSE. 
    463460         ELSE                                             ! print control done over a specific  area 
    464461            lsp_area = .TRUE. 
    … …  
    482479      ENDIF 
    483480      ! 
    484       IF( nbench == 1 ) THEN              ! Benchmark  
     481      IF( nbench == 1 ) THEN              ! Benchmark 
    485482         SELECT CASE ( cp_cfg ) 
    486483         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
    … …  
    493490         &                                               'with the IOM Input/Output manager. '         ,   & 
    494491         &                                               'Compile with key_iomput enabled' ) 
     492      ! 
     493      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
     494         &                                               'f2003 standard. '                              ,  & 
     495         &                                               'Compile with key_nosignedzero enabled' ) 
    495496      ! 
    496497   END SUBROUTINE nemo_ctl 
    … …  
    544545      !!---------------------------------------------------------------------- 
    545546      ! 
    546       ierr =        oce_alloc       ()          ! ocean  
     547      ierr =        oce_alloc       ()          ! ocean 
    547548      ierr = ierr + dia_wri_alloc   () 
    548549      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    … …  
    568569      !!                 ***  ROUTINE nemo_partition  *** 
    569570      !! 
    570       !! ** Purpose :    
     571      !! ** Purpose : 
    571572      !! 
    572573      !! ** Method  : 
    … …  
    616617      !! 
    617618      !! ** Purpose :   return the prime factors of n. 
    618       !!                knfax factors are returned in array kfax which is of  
     619      !!                knfax factors are returned in array kfax which is of 
    619620      !!                maximum dimension kmaxfax. 
    620621      !! ** Method  : 
    … …  
    684685      !!===================================================================== 
    685686      !!---------------------------------------------------------------------- 
    686       !!  
     687      !! 
    687688      !! ** Purpose :   Initialization of the northern neighbours lists. 
    688689      !!---------------------------------------------------------------------- 
    689       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  
     690      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    690691      !!---------------------------------------------------------------------- 
    691692 
    … …  
    769770      jtyp = 5 
    770771      lrankset = .FALSE. 
    771       znnbrs = narea  
     772      znnbrs = narea 
    772773      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 
    773774 
    … …  
    782783      ENDIF 
    783784 
    784       znnbrs = narea  
     785      znnbrs = narea 
    785786      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 
    786787 
    … …  
    805806         END DO 
    806807         ! 
    807          ! For northern row areas, set l_north_nogather so that all subsequent exchanges  
     808         ! For northern row areas, set l_north_nogather so that all subsequent exchanges 
    808809         ! can use peer to peer communications at the north fold 
    809810         ! 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/step.F90

    r3701 r3764  
    2929   !!   stp             : OPA system time-stepping 
    3030   !!---------------------------------------------------------------------- 
    31    USE step_oce         ! time stepping definition modules  
     31   USE step_oce         ! time stepping definition modules 
    3232#if defined key_top 
    3333   USE trcstp           ! passive tracer time-stepping      (trc_stp routine) 
    … …  
    6262      !!---------------------------------------------------------------------- 
    6363      !!                     ***  ROUTINE stp  *** 
    64       !!                       
     64      !! 
    6565      !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.) 
    6666      !!              - Time stepping of LIM (dynamic and thermodynamic eqs.) 
    6767      !!              - Tme stepping  of TRC (passive tracer eqs.) 
    68       !!  
    69       !! ** Method  : -1- Update forcings and data   
    70       !!              -2- Update ocean physics  
    71       !!              -3- Compute the t and s trends  
    72       !!              -4- Update t and s  
     68      !! 
     69      !! ** Method  : -1- Update forcings and data 
     70      !!              -2- Update ocean physics 
     71      !!              -3- Compute the t and s trends 
     72      !!              -4- Update t and s 
    7373      !!              -5- Compute the momentum trends 
    7474      !!              -6- Update the horizontal velocity 
    … …  
    8686# if defined key_iomput 
    8787      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap 
    88 # endif    
    89 #endif    
     88# endif 
     89#endif 
    9090                             indic = 0                ! reset to no error condition 
    9191      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    … …  
    113113                         CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency 
    114114      ! 
    115       !  VERTICAL PHYSICS    
     115      !  VERTICAL PHYSICS 
    116116                         CALL zdf_bfr( kstp )         ! bottom friction 
    117                           
     117 
    118118      !                                               ! Vertical eddy viscosity and diffusivity coefficients 
    119119      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz 
    … …  
    135135      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    136136         &               CALL zdf_ddm( kstp )         ! double diffusive mixing 
    137           
     137 
    138138                         CALL zdf_mxl( kstp )         ! mixed layer depth 
    139139 
    … …  
    142142      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
    143143      ! 
    144       !  LATERAL  PHYSICS  
     144      !  LATERAL  PHYSICS 
    145145      ! 
    146146      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
    … …  
    211211         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &    ! zps: time filtered hor. derivative 
    212212            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    213           
     213 
    214214      ELSE                                                  ! centered hpg  (eos then time stepping) 
    215215                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation 
    … …  
    218218         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    219219                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    220       ENDIF  
     220      ENDIF 
    221221 
    222222      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    228228      IF(  ln_asmiau .AND. & 
    229229         & ln_dyninc       )   CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
     230      IF( ln_bkgwri )          CALL asm_bkg_wri( kstp )     ! output background fields 
    230231      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified) 
    231232      IF( lk_bdy           )   CALL bdy_dyn3d_dmp(kstp )    ! bdy damping trends 
    … …  
    238239#endif 
    239240                               CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure 
    240                                CALL dyn_bfr( kstp )         ! bottom friction    
     241                               CALL dyn_bfr( kstp )         ! bottom friction 
    241242                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    242243                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
    … …  
    263264      ! Trends                              (ua, va, tsa used as workspace) 
    264265      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    265       IF( nstop == 0 ) THEN                          
    266          IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics  
     266      IF( nstop == 0 ) THEN 
     267         IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics 
    267268         IF( lk_trdtra     )   CALL trd_twr( kstp )         ! trends: active tracers 
    268          IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer  
     269         IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer 
    269270         IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget 
    270271      ENDIF 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r3680 r3764  
    77   !!---------------------------------------------------------------------- 
    88   USE oce              ! ocean dynamics and tracers variables 
    9    USE dom_oce          ! ocean space and time domain variables  
     9   USE dom_oce          ! ocean space and time domain variables 
    1010   USE zdf_oce          ! ocean vertical physics variables 
    1111   USE ldftra_oce       ! ocean tracer   - trends 
    … …  
    8484   USE trdmld_rst       ! restart for mixed-layer trends 
    8585   USE trdmod_oce       ! ocean momentum/tracers trends 
    86    USE trdmod           ! momentum/tracers trends    
     86   USE trdmod           ! momentum/tracers trends 
    8787   USE trdvor           ! vorticity budget                 (trd_vor routine) 
    8888   USE diaptr           ! poleward transports              (dia_ptr routine) 
    … …  
    9898   USE asminc           ! assimilation increments      (tra_asm_inc routine) 
    9999   !                                                   (dyn_asm_inc routine) 
    100  
     100   USE asmbkg 
    101101   USE stpctl           ! time stepping control            (stp_ctl routine) 
    102102   USE prtctl           ! Print control                    (prt_ctl routine) 
    … …  
    104104   USE diaobs           ! Observation operator 
    105105 
    106    USE timing           ! Timing             
     106   USE timing           ! Timing 
    107107 
    108108#if defined key_agrif 

  • branches/2012/dev_MERGE_2012/NEMOGCM/SETTE/iodef_sette.xml

    r3715 r3764  
    6767  </context> 
    6868   
    69  
    7069  <context id="xios"> 
    7170 
Note: See TracChangeset for help on using the changeset viewer.