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 3116 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM – NEMO

Ignore:
Timestamp:
2011-11-15T21:55:40+01:00 (12 years ago)
Author:
cetlod
Message:

dev_NEMO_MERGE_2011: add in changes dev_NOC_UKMO_MERGE developments

Location:
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM
Files:
113 edited
20 copied

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS4.fcm

    r2364 r3116  
    2222# Note use of -Bstatic because the library root directories are not accessible to the back-end compute nodes 
    2323%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -Bstatic -lnetcdf -lhdf5_fortran -lhdf5_hl -lhdf5 -Bdynamic -lz 
    24 %FC                  mpif90 
     24%FC                  ifort 
    2525%FCFLAGS             -r8 -O3 -xT -ip -vec-report0 
    2626%FFLAGS              -r8 -O3 -xT -ip -vec-report0 
    27 %LD                  mpif90 
     27%LD                  ifort 
    2828%FPPFLAGS            -P -C -traditional 
    29 %LDFLAGS 
     29%LDFLAGS             -lmpi 
    3030%AR                  ar  
    3131%ARFLAGS             -r 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist

    r3113 r3116  
    9494/ 
    9595!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     96&namtsd    !   data : Temperature  & Salinity 
     97!----------------------------------------------------------------------- 
     98!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     99!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     100   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     101   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101102   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     103   cn_dir        = './'     !  root directory for the location of the runoff files 
     104   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     105   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     106/ 
    114107!!====================================================================== 
    115108!!            ***  Surface Boundary Condition namelists  *** 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_pisces

    r3034 r3116  
    1515&nampisext     !   air-sea exchange 
    1616!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    17    atcco2     = 287.    ! atmospheric pCO2 
     17   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F) 
     18   atcco2     =  287.    ! Constant value atmospheric pCO2 - ln_co2int = F 
     19   clname     =  'atcco2.txt'  ! Name of atm pCO2 file - ln_co2int = T 
     20   nn_offset  =  0       ! Offset model-data start year - ln_co2int = T 
     21!                        ! If your model year is iyy, nn_offset=(years(1)-iyy)  
     22!                        ! then the first atmospheric CO2 record read is at years(1) 
     23/ 
     24!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     25&nampisatm     !  Atmospheric prrssure  
     26!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     27!              !  file name   ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     28!              !              !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     29   sn_patm     = 'presatm'    ,     -1            , 'patm'     ,  .true.      , .true. ,   'yearly'  , ''       , '' 
     30   cn_dir      = './'     !  root directory for the location of the dynamical files 
     31! 
     32   ln_presatm  = .true.   ! constant atmopsheric pressure (F) or from a file (T) 
    1833/ 
    1934!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    2035&nampisbio     !   biological parameters 
    2136!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    22    part       =  0.85    ! part of calcite not dissolved in guts 
    23    nrdttrc    =  1       ! time step frequency for biology 
    24    wsbio      =  2.      ! POC sinking speed 
    25    xkmort     =  1.E-7   ! half saturation constant for mortality 
    26    ferat3     =  3.E-6   ! Fe/C in zooplankton  
    27    wsbio2     =  30.     ! Big particles sinking speed 
     37   nrdttrc    =  1        ! time step frequency for biology 
     38   wsbio      =  2.       ! POC sinking speed 
     39   xkmort     =  1.E-7    ! half saturation constant for mortality 
     40   ferat3     =  10.E-6   ! Fe/C in zooplankton  
     41   wsbio2     =  30.      ! Big particles sinking speed 
    2842/ 
    2943!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    … …  
    3145!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    3246   conc0      =  2.e-6    ! Phosphate half saturation 
    33    conc1      =  10E-6    ! Phosphate half saturation for diatoms 
    34    conc2      =  0.01E-9  ! Iron half saturation for phyto 
    35    conc2m     =  0.08E-9  ! Max iron half saturation for phyto 
    36    conc3      =  0.1E-9   ! Iron half saturation for diatoms 
    37    conc3m     =  0.4E-9   ! Maxi iron half saturation for diatoms 
     47   conc1      =  8E-6     ! Phosphate half saturation for diatoms 
     48   conc2      =  2E-9     ! Iron half saturation for phyto 
     49   conc2m     =  4E-9     ! Max iron half saturation for phyto 
     50   conc3      =  3E-9     ! Iron half saturation for diatoms 
     51   conc3m     =  9E-9     ! Maxi iron half saturation for diatoms 
     52   xsizedia   =  5.E-7    ! Minimum size criteria for diatoms 
     53   xsizephy   =  1.E-6    ! Minimum size criteria for phyto 
    3854   concnnh4   =  1.E-7    ! NH4 half saturation for phyto 
    39    concdnh4   =  5.E-7    ! NH4 half saturation for diatoms 
     55   concdnh4   =  4.E-7    ! NH4 half saturation for diatoms 
    4056   xksi1      =  2.E-6    ! half saturation constant for Si uptake 
    4157   xksi2      =  3.33E-6  ! half saturation constant for Si/C 
    4258   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization 
    43    caco3r     =  0.15     ! mean rain ratio 
     59   concfebac  =  3.E-11   ! Half-saturation for Fe limitation of Bacteria 
     60   qnfelim    =  7.E-6    ! Optimal quota of phyto 
     61   qdfelim    =  7.E-6    ! Optimal quota of diatoms 
     62   caco3r     =  0.16     ! mean rain ratio 
    4463/ 
    4564!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    4665&nampisprod     !   parameters for phytoplankton growth 
    4766!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    48    pislope    =  3.       ! P-I slope   
    49    pislope2   =  3.       ! P-I slope  for diatoms 
     67   pislope    =  3.       ! P-I slope 
     68   pislope2   =  2.       ! P-I slope  for diatoms 
    5069   excret     =  0.05     ! excretion ratio of phytoplankton 
    5170   excret2    =  0.05     ! excretion ratio of diatoms 
     71   ln_newprod =  .false.  ! Enable new parame. of production (T/F)  
     72   bresp      =  0.00333  ! Basal respiration rate 
    5273   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton 
    53    chlcdm     =  0.05     ! Minimum Chl/C in diatoms 
    54    fecnm      =  10E-6    ! Maximum Fe/C in nanophytoplankton 
    55    fecdm      =  15E-6    ! Minimum Fe/C in diatoms 
     74   chlcdm     =  0.04     ! Minimum Chl/C in diatoms 
     75   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton 
     76   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton 
     77   fecdm      =  40E-6    ! Minimum Fe/C in diatoms 
    5678   grosip     =  0.151    ! mean Si/C ratio 
    5779/ 
    … …  
    6890&nampismes     !   parameters for mesozooplankton 
    6991!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     92   part2      =  0.75    ! part of calcite not dissolved in mesozoo guts 
    7093   grazrat2   =  0.7      ! maximal mesozoo grazing rate 
    7194   resrat2    =  0.005    ! exsudation rate of mesozooplankton 
    7295   mzrat2     =  0.03     ! mesozooplankton mortality rate 
    7396   xprefc     =  1.       ! zoo preference for phyto 
    74    xprefp     =  0.2      ! zoo preference for POC 
     97   xprefp     =  0.3      ! zoo preference for POC 
    7598   xprefz     =  1.       ! zoo preference for zoo 
    76    xprefpoc   =  0.2      ! zoo preference for poc 
     99   xprefpoc   =  0.3      ! zoo preference for poc 
     100   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton  
     101   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton  
     102   xthresh2phy = 2E-7     ! nanophyto feeding threshold for mesozooplankton  
     103   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton  
     104   xthresh2   =  0.       ! Food threshold for grazing 
    77105   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing 
    78    epsher2    =  0.33     ! Efficicency of Mesozoo growth  
     106   epsher2    =  0.33     ! Efficicency of Mesozoo growth 
    79107   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM 
    80108   unass2     =  0.3      ! non assimilated fraction of P by mesozoo 
    81    grazflux   =  5.e3     ! flux-feeding rate 
     109   grazflux   =  3.e3     ! flux-feeding rate 
    82110/ 
    83111!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    84112&nampiszoo     !   parameters for microzooplankton 
    85113!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    86    grazrat    =  4.0      ! maximal zoo grazing rate    
     114   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa 
     115   grazrat    =  3.0      ! maximal zoo grazing rate 
    87116   resrat     =  0.03     ! exsudation rate of zooplankton 
    88117   mzrat      =  0.0      ! zooplankton mortality rate 
    89    xpref2c    =  0.1      ! Microzoo preference for POM  
    90    xpref2p    =  0.45     ! Microzoo preference for Nanophyto 
    91    xpref2d    =  0.45     ! Microzoo preference for Diatoms 
    92    xkgraz     =  20.E-6   ! half sturation constant for grazing  
     118   xpref2c    =  0.1      ! Microzoo preference for POM 
     119   xpref2p    =  1.       ! Microzoo preference for Nanophyto 
     120   xpref2d    =  0.6      ! Microzoo preference for Diatoms 
     121   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton  
     122   xthreshphy =  2.E-7    ! Nanophyto feeding threshold for microzooplankton  
     123   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton  
     124   xthresh    =  0.       ! Food threshold for feeding 
     125   xkgraz     =  20.E-6   ! half sturation constant for grazing 
    93126   epsher     =  0.33     ! Efficiency of microzoo growth 
    94127   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM 
    … …  
    98131&nampisrem     !   parameters for remineralization 
    99132!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    100    xremik    =  0.3       ! remineralization rate of DOC 
     133   xremik    =  0.25      ! remineralization rate of DOC 
    101134   xremip    =  0.025     ! remineralisation rate of POC 
    102135   nitrif    =  0.05      ! NH4 nitrification rate 
    103    xsirem    =  0.015     ! remineralization rate of Si 
     136   xsirem    =  0.003     ! remineralization rate of Si 
     137   xsiremlab =  0.025     ! fast remineralization rate of Si 
     138   xsilab    =  0.31      ! Fraction of labile biogenic silica 
    104139   xlam1     =  0.005     ! scavenging rate of Iron 
    105    oxymin    =  1.E-6     ! Half-saturation constant for anoxia  
     140   oxymin    =  1.E-6     ! Half-saturation constant for anoxia 
     141   ligand    =  0.6E-9    ! Ligands concentration 
    106142/ 
    107143!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    108144&nampiscal     !   parameters for Calcite chemistry 
    109145!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    110    kdca       =  0.327e3  ! calcite dissolution rate constant (1/time) 
     146   kdca       =  6.       ! calcite dissolution rate constant (1/time) 
    111147   nca        =  1.       ! order of dissolution reaction (dimensionless) 
    112148/ 
    … …  
    114150&nampissed     !   parameters for inputs deposition 
    115151!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    116    ln_dustfer  =  .false.   ! boolean for dust input from the atmosphere 
    117    ln_river    =  .false.  ! boolean for river input of nutrients 
     152!              !  file name        ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     153!              !                   !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     154   sn_dust     = 'dust.orca'       ,     -1            , 'dust'     ,  .true.      , .true. ,   'yearly'  , ''       , '' 
     155   sn_riverdic = 'river.orca'      ,    -12            , 'riverdic' ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     156   sn_riverdoc = 'river.orca'      ,    -12            , 'riverdoc' ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     157   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'     ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     158   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'    ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     159! 
     160   cn_dir      = './'      !  root directory for the location of the dynamical files 
     161   ln_dust     =  .false.   ! boolean for dust input from the atmosphere 
     162   ln_river    =  .false.   ! boolean for river input of nutrients 
    118163   ln_ndepo    =  .false.   ! boolean for atmospheric deposition of N 
    119    ln_sedinput =  .false.   ! boolean for Fe input from sediments 
     164   ln_ironsed =  .false.   ! boolean for Fe input from sediments 
    120165   sedfeinput  =  1E-9     ! Coastal release of Iron 
    121    dustsolub   =  0.014    ! Solubility of the dust 
     166   dustsolub   =  0.02     ! Solubility of the dust 
     167   wdust       =  2.0      ! Dust sinking speed 
     168   nitrfix     =  1E-7     ! Nitrogen fixation rate 
     169   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2) 
     170   concfediaz  =  1.E-10   ! Diazotrophs half-saturation Cste for Iron 
    122171/ 
    123172!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    … …  
    140189/ 
    141190!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    142 &nampisdia     !   additional 2D/3D tracers diagnostics ("key_trc_diaadd") 
    143 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    144    nn_writedia  =  5475   !  time step frequency for tracers diagnostics 
    145 ! 
     191&nampisdia     !   additional 2D/3D tracers diagnostics  
     192!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    146193!              !    name   !           title of the field          !     units      ! 
    147194!              !           !                                       !                !   
    … …  
    175222!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    176223   ln_pisdmp    =  .true.     !  Relaxation fo some tracers to a mean value 
    177 / 
     224   nn_pisdmp    =  5475       !  Frequency of Relaxation  
     225/ 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_top

    r3034 r3116  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    ) 
    3 !! namelists    2 - dynamical tracer trends               (namtrc_trd) 
     3!!              2 - tracer data initialisation            (namtrc_dta) 
    44!!              3 - tracer advection                      (namtrc_adv) 
    55!!              4 - tracer lateral diffusion              (namtrc_ldf) 
    66!!              5 - tracer vertical physics               (namtrc_zdf) 
    77!!              6 - tracer newtonian damping              (namtrc_dmp) 
     8!!              7 - dynamical tracer trends               (namtrc_trd) 
     9!!              8 - tracer output diagonstics             (namtrc_dia) 
    810!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    911!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    1012&namtrc     !   tracers definition 
    1113!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    12    nn_dttrc      =  1       !  time step frequency for passive sn_tracers       
     14   nn_dttrc      =  1        !  time step frequency for passive sn_tracers       
    1315   nn_writetrc   =  10     !  time step frequency for sn_tracer outputs 
    1416   ln_rsttr      = .false.   !  start from a restart file (T) or not (F) 
    … …  
    1820   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    1921   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     22   ln_trcdta     =   .false. !  Initialisation from data input file (T) or not (F) 
    2023! 
    2124!              !    name   !           title of the field              !   units    ! initial data ! save   ! 
    2225!              !           !                                           !            ! from file    ! or not !  
    2326!              !           !                                           !            ! or not       !        ! 
    24    sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .false.     ,  .true. 
    25    sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .false.     ,  .true. 
    26    sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .false.     ,  .true. 
     27   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true. 
     28   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true. 
     29   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true. 
    2730   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true. 
    28    sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .false.     ,  .true. 
     31   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true. 
    2932   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true. 
    30    sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .false.     ,  .true. 
     33   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true. 
    3134   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true. 
    3235   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true. 
    … …  
    3538   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true. 
    3639   sn_tracer(13)  = 'BSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true. 
    37    sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .false.     ,  .true. 
     40   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true. 
    3841   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true. 
    3942   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true. 
    … …  
    4447   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true. 
    4548   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true. 
    46    sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .false.     ,  .true. 
     49   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true. 
    4750   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true. 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtrc_dta      !    Initialisation from data input file 
     54!----------------------------------------------------------------------- 
     55! 
     56!                !  file name               ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     57!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     58   sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     59   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , '' 
     60   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , '' 
     61   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , '' 
     62   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , '' 
     63   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     64   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     65   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , '' 
     66! 
     67   cn_dir        =  './'      !  root directory for the location of the data files 
     68   rn_trfac(1)   =   1.0e-06  !  multiplicative factor 
     69   rn_trfac(2)   =   1.0e-06  !  -      -      -     - 
     70   rn_trfac(3)   =  44.6e-06  !  -      -      -     - 
     71   rn_trfac(5)   = 122.0e-06  !  -      -      -     - 
     72   rn_trfac(7)   =   1.0e-06  !  -      -      -     - 
     73   rn_trfac(10)  =   1.0      !  -      -      -     - 
     74   rn_trfac(14)  =   1.0      !  -      -      -     - 
     75   rn_trfac(23)  =   7.6e-06  !  -      -      -     - 
    4876/ 
    4977!----------------------------------------------------------------------- 
    … …  
    6997   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp") 
    7098!                               !  Coefficient 
     99   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    71100   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s] 
    72101/ 
    … …  
    83112/ 
    84113!----------------------------------------------------------------------- 
    85 &namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp') 
     114&namtrc_dmp    !   passive tracer newtonian damping    
    86115!----------------------------------------------------------------------- 
     116   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F) 
    87117   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    88118                           !                   =XX, damping poleward of XX degrees (XX>0) 
    … …  
    107137   ln_trdtrc(1)  =   .true. 
    108138   ln_trdtrc(2)  =   .true. 
    109    ln_trdtrc(3)  =   .false. 
    110    ln_trdtrc(4)  =   .false. 
    111    ln_trdtrc(5)  =   .false. 
    112    ln_trdtrc(6)  =   .false. 
    113    ln_trdtrc(7)  =   .false. 
    114    ln_trdtrc(8)  =   .false. 
    115    ln_trdtrc(9)  =   .false. 
    116    ln_trdtrc(10) =   .false. 
    117    ln_trdtrc(11) =   .false. 
    118    ln_trdtrc(12) =   .false. 
    119    ln_trdtrc(13) =   .false. 
    120    ln_trdtrc(14) =   .false. 
    121    ln_trdtrc(15) =   .false. 
    122    ln_trdtrc(16) =   .false. 
    123    ln_trdtrc(17) =   .false. 
    124    ln_trdtrc(18) =   .false. 
    125    ln_trdtrc(19) =   .false. 
    126    ln_trdtrc(20) =   .false. 
    127    ln_trdtrc(21) =   .false. 
    128    ln_trdtrc(22) =   .false. 
    129139   ln_trdtrc(23) =   .true. 
    130    ln_trdtrc(24) =   .false. 
    131140/ 
     141!----------------------------------------------------------------------- 
     142&namtrc_dia       !   parameters for passive tracer additional diagnostics 
     143!---------------------------------------------------------------------- 
     144   ln_diatrc     =  .false.  !  save additional diag. (T) or not (F) 
     145   nn_writedia   =  5475     !  time step frequency for diagnostics 
     146/ 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/cpp_AMM12_PISCES.fcm

    r3110 r3116  
    1  bld::tool::fppkeys key_top key_pisces key_diatrc key_bdy key_vectopt_loop key_amm_12km  key_dynspg_ts key_ldfslp  key_zdfgls  key_vvl key_diainstant key_mpp_mpi 
     1 bld::tool::fppkeys key_top key_pisces key_bdy key_vectopt_loop key_amm_12km  key_dynspg_ts key_ldfslp  key_zdfgls  key_vvl key_diainstant key_mpp_mpi 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r3105 r3116  
    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, namsbc_cpl_co2 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) 
    … …  
    114114!!   namsbc_mfs      MFS  bulk formulae formulation 
    115115!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
    116 !!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle") 
    117116!!   namtra_qsr      penetrative solar radiation 
    118117!!   namsbc_rnf      river runoffs 
    … …  
    222221&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
    223222!----------------------------------------------------------------------- 
    224 !                                      ! send 
    225 cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    226 cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice' 
    227 cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow' 
    228 cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    229 cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian' 
    230 cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    231 cn_snd_crt_grid   = 'T'                     !  'T' 
    232 !                                      ! receive 
    233 cn_rcv_w10m       = 'none'                  !  'none' 'coupled' 
    234 cn_rcv_taumod     = 'coupled'               !  'none' 'coupled' 
    235 cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice' 
    236 cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian' 
    237 cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    238 cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    239 cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled' 
    240 cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    241 cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    242 cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice' 
    243 cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed' 
    244 cn_rcv_cal        = 'coupled'               !  'none' 'coupled' 
    245 / 
    246 !----------------------------------------------------------------------- 
    247 &namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle") 
    248 !----------------------------------------------------------------------- 
    249    cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled' 
    250    cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled' 
     223!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     224!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     225! send 
     226sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
     227sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
     228sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
     229sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
     230sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     231! receive 
     232sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
     233sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     234sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
     235sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     236sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     237sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     238sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
     239sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     240sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     241sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    251242/ 
    252243!----------------------------------------------------------------------- 
    … …  
    402393&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    403394!----------------------------------------------------------------------- 
    404    cn_mask     =  ''                     !  name of mask file (ln_mask=T) 
    405    cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points) 
    406    cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points) 
    407    cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points) 
    408    cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
    409    cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
    410    cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
    411  
    412    ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic 
    413    ln_vol      = .false.   !  total volume correction (see volbdy parameter) 
    414    ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 
    415    ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition 
    416    ln_dyn_fla  = .false.   !  Apply Flather condition to velocities 
    417    ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity  
    418    ln_dyn_frs  = .false.   !  Apply FRS condition to velocities 
    419    nn_rimwidth =  9        !  width of the relaxation zone 
    420    nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state 
     395    nb_bdy = 1                            !  number of open boundary sets        
     396    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
     397    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
     398    ln_mask_file = .false.                !  =T : read mask from file 
     399    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
     400    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     401    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
     402                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     403                                          !  = 2, use tidal harmonic forcing data from files 
     404                                          !  = 3, use external data AND tidal harmonic forcing 
     405    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     406    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    421407                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    422    nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero 
    423                            !  = 1, the total volume of the system is conserved 
    424 / 
    425 !----------------------------------------------------------------------- 
    426 &nambdy_tide   !  tidal forcing at unstructured boundaries               
    427 !----------------------------------------------------------------------- 
    428    filtide     = 'bdytide_'           !  file name root of tidal forcing files 
    429    tide_cpt    = 'M2','S1'            !  names of tidal components used 
    430    tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour) 
    431    ln_tide_date= .false.              !  adjust tidal harmonics for start date of run 
    432 / 
    433  
     408    nn_tra        =  1                    !  boundary conditions for T and S 
     409    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
     410                           !  = 1, bdy data are read in 'bdydata   .nc' files 
     411    nn_rimwidth  = 10                      !  width of the relaxation zone 
     412    nn_dmp2d_in  = 0                      ! 
     413    nn_dmp2d_out = 0                      ! 
     414    nn_dmp2d_in  = 0                      ! 
     415    nn_dmp2d_out = 0                      ! 
     416    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
     417    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 
     418/ 
     419!----------------------------------------------------------------------- 
     420&nambdy_dta      !  open boundaries - external data           ("key_bdy") 
     421!----------------------------------------------------------------------- 
     422!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! 
     423!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! 
     424   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     425   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     426   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     427   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     428   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     429   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     430   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     431   cn_dir  =    'bdydta/' 
     432   ln_full_vel = .false. 
     433/ 
     434!----------------------------------------------------------------------- 
     435&nambdy_tide     ! tidal forcing at open boundaries               
     436!----------------------------------------------------------------------- 
     437   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
     438    tide_cpt(1)   ='Q1'  !  names of tidal components used 
     439    tide_cpt(2)   ='O1'  !  names of tidal components used 
     440    tide_cpt(3)   ='P1'  !  names of tidal components used 
     441    tide_cpt(4)   ='S1'  !  names of tidal components used 
     442    tide_cpt(5)   ='K1'  !  names of tidal components used 
     443    tide_cpt(6)   ='2N2' !  names of tidal components used 
     444    tide_cpt(7)   ='MU2' !  names of tidal components used 
     445    tide_cpt(8)   ='N2'  !  names of tidal components used 
     446    tide_cpt(9)   ='NU2' !  names of tidal components used 
     447    tide_cpt(10)   ='M2'  !  names of tidal components used 
     448    tide_cpt(11)   ='L2'  !  names of tidal components used 
     449    tide_cpt(12)   ='T2'  !  names of tidal components used 
     450    tide_cpt(13)   ='S2'  !  names of tidal components used 
     451    tide_cpt(14)   ='K2'  !  names of tidal components used 
     452    tide_cpt(15)   ='M4'  !  names of tidal components used 
     453    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour) 
     454    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour) 
     455    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour) 
     456    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour) 
     457    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour) 
     458    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour) 
     459    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour) 
     460    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour) 
     461    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour) 
     462    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour) 
     463    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour) 
     464    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour) 
     465    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour) 
     466    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour) 
     467    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour) 
     468    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run 
     469/ 
    434470!!====================================================================== 
    435471!!                 ***  Bottom boundary condition  *** 
    … …  
    450486   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    451487   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d = .true.) 
     488   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true) 
    452489/ 
    453490!----------------------------------------------------------------------- 
    … …  
    496533   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    497534   ln_traadv_ubs    =  .false.  !  UBS scheme                  
    498    ln_traadv_qck    =  .false.  !  QUCIKEST scheme                  
     535   ln_traadv_qck    =  .false.  !  QUICKEST scheme                  
    499536/ 
    500537!----------------------------------------------------------------------- 
    … …  
    508545   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T) 
    509546   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp") 
    510    ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
    511    ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
     547   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp") 
     548   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp") 
     549   ln_triad_iso     =  .false.  !  griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 
     550   ln_botmix_grif   =  .false.  !  griffies operator with lateral mixing on bottom (require "key_ldfslp") 
    512551   !                       !  Coefficient 
    513552   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    … …  
    562601   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation) 
    563602   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    564    ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification) 
    565    ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian) 
    566603   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    567    ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme) 
    568    rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme) 
     604   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    569605   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    570606                                 !           centered      time scheme  (F) 
    … …  
    735771                           !  buffer blocking send or immediate non-blocking sends, resp. 
    736772   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation 
     773   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold 
    737774   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)      
    738775   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)      
    … …  
    926963   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    927964/ 
     965!----------------------------------------------------------------------- 
     966&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
     967!----------------------------------------------------------------------- 
     968   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 
     969   ln_neptsimp       = .false.  ! yes/no use simplified neptune 
     970 
     971   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep 
     972   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator 
     973   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole 
     974   ! Specify whether to ramp down the Neptune velocity in shallow 
     975   ! water, and if so the depth range controlling such ramping down 
     976   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
     977   rn_htrmin         =  100.0   ! min. depth of transition range 
     978   rn_htrmax         =  200.0   ! max. depth of transition range 
     979/ 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist

    r3104 r3116  
    33!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    5 !!                                    namsbc_cpl, namsbc_cpl_co2 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) 
    … …  
    121121!!   namsbc_core     CORE bulk formulea formulation 
    122122!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
    123 !!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle") 
    124123!!   namtra_qsr      penetrative solar radiation 
    125124!!   namsbc_rnf      river runoffs 
    … …  
    212211&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
    213212!----------------------------------------------------------------------- 
    214 !                                      ! send 
    215 cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    216 cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice' 
    217 cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow' 
    218 cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    219 cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian' 
    220 cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    221 cn_snd_crt_grid   = 'T'                     !  'T' 
    222 !                                      ! receive 
    223 cn_rcv_w10m       = 'none'                  !  'none' 'coupled' 
    224 cn_rcv_taumod     = 'coupled'               !  'none' 'coupled' 
    225 cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice' 
    226 cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian' 
    227 cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    228 cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    229 cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled' 
    230 cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    231 cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    232 cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice' 
    233 cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed' 
    234 cn_rcv_cal        = 'coupled'               !  'none' 'coupled' 
    235 / 
    236 !----------------------------------------------------------------------- 
    237 &namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle") 
    238 !----------------------------------------------------------------------- 
    239    cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled' 
    240    cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled' 
     213!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     214!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     215! send 
     216sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
     217sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
     218sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
     219sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
     220sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     221! receive 
     222sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
     223sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     224sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
     225sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     226sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     227sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     228sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
     229sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     230sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     231sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    241232/ 
    242233!----------------------------------------------------------------------- 
    … …  
    369360&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    370361!----------------------------------------------------------------------- 
    371    cn_mask     =  ''                     !  name of mask file (ln_mask=T) 
    372    cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points) 
    373    cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points) 
    374    cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points) 
    375    cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
    376    cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
    377    cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
    378  
    379    ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic 
    380    ln_vol      = .false.   !  total volume correction (see volbdy parameter) 
    381    ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 
    382    ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition 
    383    ln_dyn_fla  = .false.   !  Apply Flather condition to velocities 
    384    ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity  
    385    ln_dyn_frs  = .false.   !  Apply FRS condition to velocities 
    386    nn_rimwidth =  9        !  width of the relaxation zone 
    387    nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state 
     362    nb_bdy = 1                            !  number of open boundary sets        
     363    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
     364    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
     365    ln_mask_file = .false.                !  =T : read mask from file 
     366    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
     367    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     368    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
     369                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     370                                          !  = 2, use tidal harmonic forcing data from files 
     371                                          !  = 3, use external data AND tidal harmonic forcing 
     372    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     373    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    388374                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    389    nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero 
    390                            !  = 1, the total volume of the system is conserved 
    391 / 
    392 !----------------------------------------------------------------------- 
    393 &nambdy_tide   !  tidal forcing at unstructured boundaries               
    394 !----------------------------------------------------------------------- 
    395    filtide     = 'bdytide_'           !  file name root of tidal forcing files 
    396    tide_cpt    = 'M2','S1'            !  names of tidal components used 
    397    tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour) 
    398    ln_tide_date= .false.              !  adjust tidal harmonics for start date of run 
    399 / 
    400  
     375    nn_tra        =  1                    !  boundary conditions for T and S 
     376    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
     377                           !  = 1, bdy data are read in 'bdydata   .nc' files 
     378    nn_rimwidth  = 10                      !  width of the relaxation zone 
     379    nn_dmp2d_in  = 0                      ! 
     380    nn_dmp2d_out = 0                      ! 
     381    nn_dmp2d_in  = 0                      ! 
     382    nn_dmp2d_out = 0                      ! 
     383    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
     384    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 
     385/ 
     386!----------------------------------------------------------------------- 
     387&nambdy_dta      !  open boundaries - external data           ("key_bdy") 
     388!----------------------------------------------------------------------- 
     389!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! 
     390!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! 
     391   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     392   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     393   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     394   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     395   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     396   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     397   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     398   cn_dir  =    'bdydta/' 
     399   ln_full_vel = .false. 
     400/ 
     401!----------------------------------------------------------------------- 
     402&nambdy_tide     ! tidal forcing at open boundaries               
     403!----------------------------------------------------------------------- 
     404   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
     405    tide_cpt(1)   ='Q1'  !  names of tidal components used 
     406    tide_cpt(2)   ='O1'  !  names of tidal components used 
     407    tide_cpt(3)   ='P1'  !  names of tidal components used 
     408    tide_cpt(4)   ='S1'  !  names of tidal components used 
     409    tide_cpt(5)   ='K1'  !  names of tidal components used 
     410    tide_cpt(6)   ='2N2' !  names of tidal components used 
     411    tide_cpt(7)   ='MU2' !  names of tidal components used 
     412    tide_cpt(8)   ='N2'  !  names of tidal components used 
     413    tide_cpt(9)   ='NU2' !  names of tidal components used 
     414    tide_cpt(10)   ='M2'  !  names of tidal components used 
     415    tide_cpt(11)   ='L2'  !  names of tidal components used 
     416    tide_cpt(12)   ='T2'  !  names of tidal components used 
     417    tide_cpt(13)   ='S2'  !  names of tidal components used 
     418    tide_cpt(14)   ='K2'  !  names of tidal components used 
     419    tide_cpt(15)   ='M4'  !  names of tidal components used 
     420    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour) 
     421    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour) 
     422    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour) 
     423    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour) 
     424    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour) 
     425    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour) 
     426    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour) 
     427    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour) 
     428    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour) 
     429    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour) 
     430    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour) 
     431    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour) 
     432    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour) 
     433    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour) 
     434    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour) 
     435    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run 
     436/ 
    401437!!====================================================================== 
    402438!!                 ***  Bottom boundary condition  *** 
    … …  
    417453   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    418454   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
     455   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true) 
    419456/ 
    420457!----------------------------------------------------------------------- 
    … …  
    528565   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation) 
    529566   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    530    ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification) 
    531    ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian) 
    532567   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    533    ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme) 
    534    rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme) 
     568   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    535569   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    536570                                 !           centered      time scheme  (F) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r3105 r3116  
    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, namsbc_cpl_co2 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) 
    … …  
    114114!!   namsbc_mfs      MFS  bulk formulae formulation 
    115115!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
    116 !!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle") 
    117116!!   namtra_qsr      penetrative solar radiation 
    118117!!   namsbc_rnf      river runoffs 
    … …  
    222221&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
    223222!----------------------------------------------------------------------- 
    224 !                                      ! send 
    225 cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    226 cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice' 
    227 cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow' 
    228 cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    229 cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian' 
    230 cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    231 cn_snd_crt_grid   = 'T'                     !  'T' 
    232 !                                      ! receive 
    233 cn_rcv_w10m       = 'none'                  !  'none' 'coupled' 
    234 cn_rcv_taumod     = 'coupled'               !  'none' 'coupled' 
    235 cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice' 
    236 cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian' 
    237 cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    238 cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    239 cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled' 
    240 cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    241 cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    242 cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice' 
    243 cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed' 
    244 cn_rcv_cal        = 'coupled'               !  'none' 'coupled' 
    245 / 
    246 !----------------------------------------------------------------------- 
    247 &namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle") 
    248 !----------------------------------------------------------------------- 
    249    cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled' 
    250    cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled' 
     223!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     224!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     225! send 
     226sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
     227sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
     228sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
     229sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
     230sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     231! receive 
     232sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
     233sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     234sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
     235sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     236sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     237sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     238sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
     239sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     240sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     241sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    251242/ 
    252243!----------------------------------------------------------------------- 
    … …  
    397388&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    398389!----------------------------------------------------------------------- 
    399    cn_mask     =  ''                     !  name of mask file (ln_mask=T) 
    400    cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points) 
    401    cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points) 
    402    cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points) 
    403    cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
    404    cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
    405    cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
    406  
    407    ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic 
    408    ln_vol      = .false.   !  total volume correction (see volbdy parameter) 
    409    ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 
    410    ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition 
    411    ln_dyn_fla  = .false.   !  Apply Flather condition to velocities 
    412    ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity  
    413    ln_dyn_frs  = .false.   !  Apply FRS condition to velocities 
    414    nn_rimwidth =  9        !  width of the relaxation zone 
    415    nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state 
     390    nb_bdy = 1                            !  number of open boundary sets        
     391    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
     392    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
     393    ln_mask_file = .false.                !  =T : read mask from file 
     394    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
     395    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     396    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
     397                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     398                                          !  = 2, use tidal harmonic forcing data from files 
     399                                          !  = 3, use external data AND tidal harmonic forcing 
     400    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     401    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    416402                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    417    nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero 
    418                            !  = 1, the total volume of the system is conserved 
    419 / 
    420 !----------------------------------------------------------------------- 
    421 &nambdy_tide   !  tidal forcing at unstructured boundaries               
    422 !----------------------------------------------------------------------- 
    423    filtide     = 'bdytide_'           !  file name root of tidal forcing files 
    424    tide_cpt    = 'M2','S1'            !  names of tidal components used 
    425    tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour) 
    426    ln_tide_date= .false.              !  adjust tidal harmonics for start date of run 
    427 / 
    428  
     403    nn_tra        =  1                    !  boundary conditions for T and S 
     404    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
     405                           !  = 1, bdy data are read in 'bdydata   .nc' files 
     406    nn_rimwidth  = 10                      !  width of the relaxation zone 
     407    nn_dmp2d_in  = 0                      ! 
     408    nn_dmp2d_out = 0                      ! 
     409    nn_dmp2d_in  = 0                      ! 
     410    nn_dmp2d_out = 0                      ! 
     411    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
     412    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 
     413/ 
     414!----------------------------------------------------------------------- 
     415&nambdy_dta      !  open boundaries - external data           ("key_bdy") 
     416!----------------------------------------------------------------------- 
     417!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! 
     418!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! 
     419   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     420   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     421   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     422   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     423   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     424   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     425   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     426   cn_dir  =    'bdydta/' 
     427   ln_full_vel = .false. 
     428/ 
     429!----------------------------------------------------------------------- 
     430&nambdy_tide     ! tidal forcing at open boundaries               
     431!----------------------------------------------------------------------- 
     432   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
     433    tide_cpt(1)   ='Q1'  !  names of tidal components used 
     434    tide_cpt(2)   ='O1'  !  names of tidal components used 
     435    tide_cpt(3)   ='P1'  !  names of tidal components used 
     436    tide_cpt(4)   ='S1'  !  names of tidal components used 
     437    tide_cpt(5)   ='K1'  !  names of tidal components used 
     438    tide_cpt(6)   ='2N2' !  names of tidal components used 
     439    tide_cpt(7)   ='MU2' !  names of tidal components used 
     440    tide_cpt(8)   ='N2'  !  names of tidal components used 
     441    tide_cpt(9)   ='NU2' !  names of tidal components used 
     442    tide_cpt(10)   ='M2'  !  names of tidal components used 
     443    tide_cpt(11)   ='L2'  !  names of tidal components used 
     444    tide_cpt(12)   ='T2'  !  names of tidal components used 
     445    tide_cpt(13)   ='S2'  !  names of tidal components used 
     446    tide_cpt(14)   ='K2'  !  names of tidal components used 
     447    tide_cpt(15)   ='M4'  !  names of tidal components used 
     448    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour) 
     449    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour) 
     450    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour) 
     451    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour) 
     452    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour) 
     453    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour) 
     454    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour) 
     455    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour) 
     456    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour) 
     457    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour) 
     458    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour) 
     459    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour) 
     460    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour) 
     461    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour) 
     462    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour) 
     463    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run 
     464/ 
    429465!!====================================================================== 
    430466!!                 ***  Bottom boundary condition  *** 
    … …  
    445481   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    446482   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
     483   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true) 
    447484/ 
    448485!----------------------------------------------------------------------- 
    … …  
    491528   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    492529   ln_traadv_ubs    =  .false.  !  UBS scheme                  
    493    ln_traadv_qck    =  .false.  !  QUCIKEST scheme                  
     530   ln_traadv_qck    =  .false.  !  QUICKEST scheme                  
    494531/ 
    495532!----------------------------------------------------------------------- 
    … …  
    503540   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T) 
    504541   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp") 
    505    ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
    506    ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
    507    !                       !  Coefficient 
     542   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp") 
     543   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp") 
     544   ln_triad_iso     =  .false.  !  griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 
     545   ln_botmix_grif   =  .false.  !  griffies operator with lateral mixing on bottom (require "key_ldfslp") 
     546                         !  Coefficient 
    508547   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    509548   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s] 
    … …  
    557596   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation) 
    558597   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    559    ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification) 
    560    ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian) 
    561598   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    562    ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme) 
    563    rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme) 
     599   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    564600   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    565601                                 !           centered      time scheme  (F) 
    … …  
    730766                           !  buffer blocking send or immediate non-blocking sends, resp. 
    731767   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation 
     768   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold 
    732769   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1) 
    733770   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1) 
    … …  
    931968   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    932969/ 
     970!----------------------------------------------------------------------- 
     971&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
     972!----------------------------------------------------------------------- 
     973   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 
     974   ln_neptsimp       = .false.  ! yes/no use simplified neptune 
     975 
     976   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep 
     977   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator 
     978   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole 
     979   ! Specify whether to ramp down the Neptune velocity in shallow 
     980   ! water, and if so the depth range controlling such ramping down 
     981   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water 
     982   rn_htrmin         =  100.0   ! min. depth of transition range 
     983   rn_htrmax         =  200.0   ! max. depth of transition range 
     984/ 
     985>>>>>>> .merge-right.r3114 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r3105 r3116  
    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, namsbc_cpl_co2 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) 
    … …  
    114114!!   namsbc_mfs      MFS  bulk formulae formulation 
    115115!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
    116 !!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle") 
    117116!!   namtra_qsr      penetrative solar radiation 
    118117!!   namsbc_rnf      river runoffs 
    … …  
    222221&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
    223222!----------------------------------------------------------------------- 
    224 !                                      ! send 
    225 cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    226 cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice' 
    227 cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow' 
    228 cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    229 cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian' 
    230 cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    231 cn_snd_crt_grid   = 'T'                     !  'T' 
    232 !                                      ! receive 
    233 cn_rcv_w10m       = 'none'                  !  'none' 'coupled' 
    234 cn_rcv_taumod     = 'coupled'               !  'none' 'coupled' 
    235 cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice' 
    236 cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian' 
    237 cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    238 cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    239 cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled' 
    240 cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    241 cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    242 cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice' 
    243 cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed' 
    244 cn_rcv_cal        = 'coupled'               !  'none' 'coupled' 
    245 / 
    246 !----------------------------------------------------------------------- 
    247 &namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle") 
    248 !----------------------------------------------------------------------- 
    249    cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled' 
    250    cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled' 
    251 / 
    252 !----------------------------------------------------------------------- 
     223!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     224!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     225! send 
     226sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
     227sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
     228sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
     229sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
     230sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     231! receive 
     232sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
     233sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     234sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
     235sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     236sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     237sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     238sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
     239sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     240sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     241sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     242/ 
    253243&namtra_qsr    !   penetrative solar radiation 
    254244!----------------------------------------------------------------------- 
    … …  
    380370&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    381371!----------------------------------------------------------------------- 
    382    cn_mask     =  ''                     !  name of mask file (ln_mask=T) 
    383    cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points) 
    384    cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points) 
    385    cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points) 
    386    cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
    387    cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
    388    cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
    389  
    390    ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic 
    391    ln_vol      = .false.   !  total volume correction (see volbdy parameter) 
    392    ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 
    393    ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition 
    394    ln_dyn_fla  = .false.   !  Apply Flather condition to velocities 
    395    ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity  
    396    ln_dyn_frs  = .false.   !  Apply FRS condition to velocities 
    397    nn_rimwidth =  9        !  width of the relaxation zone 
    398    nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state 
     372    nb_bdy = 1                            !  number of open boundary sets        
     373    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
     374    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
     375    ln_mask_file = .false.                !  =T : read mask from file 
     376    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
     377    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     378    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
     379                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     380                                          !  = 2, use tidal harmonic forcing data from files 
     381                                          !  = 3, use external data AND tidal harmonic forcing 
     382    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     383    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    399384                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    400    nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero 
    401                            !  = 1, the total volume of the system is conserved 
    402 / 
    403 !----------------------------------------------------------------------- 
    404 &nambdy_tide   !  tidal forcing at unstructured boundaries               
    405 !----------------------------------------------------------------------- 
    406    filtide     = 'bdytide_'           !  file name root of tidal forcing files 
    407    tide_cpt    = 'M2','S1'            !  names of tidal components used 
    408    tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour) 
    409    ln_tide_date= .false.              !  adjust tidal harmonics for start date of run 
    410 / 
    411  
     385    nn_tra        =  1                    !  boundary conditions for T and S 
     386    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
     387                           !  = 1, bdy data are read in 'bdydata   .nc' files 
     388    nn_rimwidth  = 10                      !  width of the relaxation zone 
     389    nn_dmp2d_in  = 0                      ! 
     390    nn_dmp2d_out = 0                      ! 
     391    nn_dmp2d_in  = 0                      ! 
     392    nn_dmp2d_out = 0                      ! 
     393    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
     394    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 
     395/ 
     396!----------------------------------------------------------------------- 
     397&nambdy_dta      !  open boundaries - external data           ("key_bdy") 
     398!----------------------------------------------------------------------- 
     399!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! 
     400!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! 
     401   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     402   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     403   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     404   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     405   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     406   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     407   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     408   cn_dir  =    'bdydta/' 
     409   ln_full_vel = .false. 
     410/ 
     411!----------------------------------------------------------------------- 
     412&nambdy_tide     ! tidal forcing at open boundaries               
     413!----------------------------------------------------------------------- 
     414   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
     415    tide_cpt(1)   ='Q1'  !  names of tidal components used 
     416    tide_cpt(2)   ='O1'  !  names of tidal components used 
     417    tide_cpt(3)   ='P1'  !  names of tidal components used 
     418    tide_cpt(4)   ='S1'  !  names of tidal components used 
     419    tide_cpt(5)   ='K1'  !  names of tidal components used 
     420    tide_cpt(6)   ='2N2' !  names of tidal components used 
     421    tide_cpt(7)   ='MU2' !  names of tidal components used 
     422    tide_cpt(8)   ='N2'  !  names of tidal components used 
     423    tide_cpt(9)   ='NU2' !  names of tidal components used 
     424    tide_cpt(10)   ='M2'  !  names of tidal components used 
     425    tide_cpt(11)   ='L2'  !  names of tidal components used 
     426    tide_cpt(12)   ='T2'  !  names of tidal components used 
     427    tide_cpt(13)   ='S2'  !  names of tidal components used 
     428    tide_cpt(14)   ='K2'  !  names of tidal components used 
     429    tide_cpt(15)   ='M4'  !  names of tidal components used 
     430    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour) 
     431    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour) 
     432    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour) 
     433    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour) 
     434    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour) 
     435    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour) 
     436    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour) 
     437    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour) 
     438    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour) 
     439    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour) 
     440    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour) 
     441    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour) 
     442    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour) 
     443    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour) 
     444    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour) 
     445    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run 
     446/ 
    412447!!====================================================================== 
    413448!!                 ***  Bottom boundary condition  *** 
    … …  
    428463   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    429464   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
     465   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true) 
    430466/ 
    431467!----------------------------------------------------------------------- 
    … …  
    474510   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    475511   ln_traadv_ubs    =  .false.  !  UBS scheme                  
    476    ln_traadv_qck    =  .false.  !  QUCIKEST scheme                  
     512   ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    477513/ 
    478514!----------------------------------------------------------------------- 
    … …  
    486522   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T) 
    487523   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp") 
    488    ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
    489    ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
    490    !                       !  Coefficient 
     524   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp") 
     525   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp") 
     526   ln_triad_iso     =  .false.  !  griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 
     527   ln_botmix_grif   =  .false.  !  griffies operator with lateral mixing on bottom (require "key_ldfslp") 
     528                         !  Coefficient 
    491529   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    492530   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s] 
    … …  
    540578   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation) 
    541579   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    542    ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification) 
    543    ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian) 
    544580   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    545    ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme) 
    546    rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme) 
     581   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    547582   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T) 
    548583                                 !           centered      time scheme  (F) 
    … …  
    737772                           !  buffer blocking send or immediate non-blocking sends, resp. 
    738773   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation 
     774   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold 
    739775   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1) 
    740776   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1) 
    … …  
    928964   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    929965/ 
     966!----------------------------------------------------------------------- 
     967&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
     968!----------------------------------------------------------------------- 
     969   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 
     970   ln_neptsimp       = .false.  ! yes/no use simplified neptune 
     971 
     972   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep 
     973   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator 
     974   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole 
     975   ! Specify whether to ramp down the Neptune velocity in shallow 
     976   ! water, and if so the depth range controlling such ramping down 
     977   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
     978   rn_htrmin         =  100.0   ! min. depth of transition range 
     979   rn_htrmax         =  200.0   ! max. depth of transition range 
     980/ 
     981>>>>>>> .merge-right.r3114 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/POMME/EXP00/namelist

    r3105 r3116  
    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, namsbc_cpl_co2 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) 
    … …  
    114114!!   namsbc_mfs      MFS  bulk formulae formulation 
    115115!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
    116 !!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle") 
    117116!!   namtra_qsr      penetrative solar radiation 
    118117!!   namsbc_rnf      river runoffs 
    … …  
    222221&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled") 
    223222!----------------------------------------------------------------------- 
    224 !                                      ! send 
    225 cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    226 cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice' 
    227 cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow' 
    228 cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    229 cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian' 
    230 cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    231 cn_snd_crt_grid   = 'T'                     !  'T' 
    232 !                                      ! receive 
    233 cn_rcv_w10m       = 'none'                  !  'none' 'coupled' 
    234 cn_rcv_taumod     = 'coupled'               !  'none' 'coupled' 
    235 cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice' 
    236 cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian' 
    237 cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid' 
    238 cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    239 cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled' 
    240 cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    241 cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice' 
    242 cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice' 
    243 cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed' 
    244 cn_rcv_cal        = 'coupled'               !  'none' 'coupled' 
    245 / 
    246 !----------------------------------------------------------------------- 
    247 &namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle") 
    248 !----------------------------------------------------------------------- 
    249    cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled' 
    250    cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled' 
     223!                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     224!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     225! send 
     226sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''     
     227sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''     
     228sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''     
     229sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'        
     230sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''         
     231! receive 
     232sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''     
     233sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     234sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'    
     235sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     236sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     237sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''     
     238sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''     
     239sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     240sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
     241sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''     
    251242/ 
    252243!----------------------------------------------------------------------- 
    … …  
    402393&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    403394!----------------------------------------------------------------------- 
    404    cn_mask     =  ''                     !  name of mask file (ln_mask=T) 
    405    cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points) 
    406    cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points) 
    407    cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points) 
    408    cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
    409    cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
    410    cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
    411  
    412    ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic 
    413    ln_vol      = .false.   !  total volume correction (see volbdy parameter) 
    414    ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 
    415    ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition 
    416    ln_dyn_fla  = .false.   !  Apply Flather condition to velocities 
    417    ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity  
    418    ln_dyn_frs  = .false.   !  Apply FRS condition to velocities 
    419    nn_rimwidth =  9        !  width of the relaxation zone 
    420    nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state 
     395    nb_bdy = 1                            !  number of open boundary sets        
     396    ln_coords_file = .true.               !  =T : read bdy coordinates from file 
     397    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
     398    ln_mask_file = .false.                !  =T : read mask from file 
     399    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
     400    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     401    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
     402                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     403                                          !  = 2, use tidal harmonic forcing data from files 
     404                                          !  = 3, use external data AND tidal harmonic forcing 
     405    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     406    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    421407                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    422    nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero 
    423                            !  = 1, the total volume of the system is conserved 
    424 / 
    425 !----------------------------------------------------------------------- 
    426 &nambdy_tide   !  tidal forcing at unstructured boundaries               
    427 !----------------------------------------------------------------------- 
    428    filtide     = 'bdytide_'           !  file name root of tidal forcing files 
    429    tide_cpt    = 'M2','S1'            !  names of tidal components used 
    430    tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour) 
    431    ln_tide_date= .false.              !  adjust tidal harmonics for start date of run 
    432 / 
    433  
     408    nn_tra        =  1                    !  boundary conditions for T and S 
     409    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
     410                           !  = 1, bdy data are read in 'bdydata   .nc' files 
     411    nn_rimwidth  = 10                      !  width of the relaxation zone 
     412    nn_dmp2d_in  = 0                      ! 
     413    nn_dmp2d_out = 0                      ! 
     414    nn_dmp2d_in  = 0                      ! 
     415    nn_dmp2d_out = 0                      ! 
     416    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
     417    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 
     418/ 
     419!----------------------------------------------------------------------- 
     420&nambdy_dta      !  open boundaries - external data           ("key_bdy") 
     421!----------------------------------------------------------------------- 
     422!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! 
     423!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! 
     424   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     425   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     426   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     427   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     428   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     429   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     430   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   '' 
     431   cn_dir  =    'bdydta/' 
     432   ln_full_vel = .false. 
     433/ 
     434!----------------------------------------------------------------------- 
     435&nambdy_tide     ! tidal forcing at open boundaries               
     436!----------------------------------------------------------------------- 
     437   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files 
     438    tide_cpt(1)   ='Q1'  !  names of tidal components used 
     439    tide_cpt(2)   ='O1'  !  names of tidal components used 
     440    tide_cpt(3)   ='P1'  !  names of tidal components used 
     441    tide_cpt(4)   ='S1'  !  names of tidal components used 
     442    tide_cpt(5)   ='K1'  !  names of tidal components used 
     443    tide_cpt(6)   ='2N2' !  names of tidal components used 
     444    tide_cpt(7)   ='MU2' !  names of tidal components used 
     445    tide_cpt(8)   ='N2'  !  names of tidal components used 
     446    tide_cpt(9)   ='NU2' !  names of tidal components used 
     447    tide_cpt(10)   ='M2'  !  names of tidal components used 
     448    tide_cpt(11)   ='L2'  !  names of tidal components used 
     449    tide_cpt(12)   ='T2'  !  names of tidal components used 
     450    tide_cpt(13)   ='S2'  !  names of tidal components used 
     451    tide_cpt(14)   ='K2'  !  names of tidal components used 
     452    tide_cpt(15)   ='M4'  !  names of tidal components used 
     453    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour) 
     454    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour) 
     455    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour) 
     456    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour) 
     457    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour) 
     458    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour) 
     459    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour) 
     460    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour) 
     461    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour) 
     462    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour) 
     463    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour) 
     464    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour) 
     465    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour) 
     466    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour) 
     467    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour) 
     468    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run 
     469/ 
    434470!!====================================================================== 
    435471!!                 ***  Bottom boundary condition  *** 
    … …  
    450486   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    451487   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
     488   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true) 
    452489/ 
    453490!----------------------------------------------------------------------- 
    … …  
    496533   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    497534   ln_traadv_ubs    =  .false.  !  UBS scheme                  
    498    ln_traadv_qck    =  .false.  !  QUCIKEST scheme                  
     535   ln_traadv_qck    =  .false.  !  QUICKEST scheme                  
    499536/ 
    500537!----------------------------------------------------------------------- 
    … …  
    508545   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T) 
    509546   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp") 
    510    ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
    511    ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE 
     547   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp") 
     548   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp") 
     549   ln_triad_iso     =  .false.  !  griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 
     550   ln_botmix_grif   =  .false.  !  griffies operator with lateral mixing on bottom (require "key_ldfslp") 
    512551   !                       !  Coefficient 
    513552   rn_aht_0         =   300.    !  horizontal eddy diffusivity for tracers [m2/s] 
    … …  
    562601   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation) 
    563602   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    564    ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification) 
    565    ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian) 
    566603   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial) 
    567    ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme) 
    568    rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme) 
     604   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme) 
    569605   ln_dynhpg_imp = .true.  !  time stepping: semi-implicit time scheme  (T) 
    570606                                 !           centered      time scheme  (F) 
    … …  
    931967   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files 
    932968/ 
     969!----------------------------------------------------------------------- 
     970&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed) 
     971!----------------------------------------------------------------------- 
     972   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 
     973   ln_neptsimp       = .false.  ! yes/no use simplified neptune 
     974 
     975   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep 
     976   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator 
     977   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole 
     978   ! Specify whether to ramp down the Neptune velocity in shallow 
     979   ! water, and if so the depth range controlling such ramping down 
     980   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water 
     981   rn_htrmin         =  100.0   ! min. depth of transition range 
     982   rn_htrmax         =  200.0   ! max. depth of transition range 
     983/ 
     984>>>>>>> .merge-right.r3114 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r2715 r3116  
    2727   USE sbc_ice          ! surface boundary condition: ice 
    2828   USE sbc_oce          ! surface boundary condition: ocean 
     29   USE sbccpl 
    2930 
    3031   USE albedo           ! albedo parameters 
    … …  
    234235      !-----------------------------------------------! 
    235236 
    236       IF( lk_cpl ) THEN          ! coupled case 
    237          tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    238          !                                  ! Computation of snow/ice and ocean albedo 
    239          CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 
    240          alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
    241          CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
    242       ENDIF 
     237#if defined key_coupled 
     238      tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
     239      ht_i(:,:,1) = hicif(:,:) 
     240      ht_s(:,:,1) = hsnif(:,:) 
     241      a_i(:,:,1) = fr_i(:,:) 
     242      !                                  ! Computation of snow/ice and ocean albedo 
     243      CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
     244      alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     245      CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
     246#endif 
    243247 
    244248      IF(ln_ctl) THEN            ! control print 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r2715 r3116  
    372372          DO ji = kideb, kiut 
    373373             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 
     374             qla_ice_1d(ji) = -9999.   ! default definition, not used as parsub = 0. in this case 
    374375             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) ) 
    375376          END DO 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r2715 r3116  
    77   !!            3.0  !  2008-04  (NEMO team)  add in the reference version      
    88   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions 
     9   !!            3.4  !  2011     (D. Storkey, J. Chanut) OBC-BDY merge 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_bdy  
    … …  
    1920   PUBLIC 
    2021 
     22   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary 
     23      INTEGER,          DIMENSION(jpbgrd) ::  nblen 
     24      INTEGER,          DIMENSION(jpbgrd) ::  nblenrim 
     25      INTEGER, POINTER, DIMENSION(:,:)   ::  nbi 
     26      INTEGER, POINTER, DIMENSION(:,:)   ::  nbj 
     27      INTEGER, POINTER, DIMENSION(:,:)   ::  nbr 
     28      INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap 
     29      REAL   , POINTER, DIMENSION(:,:)   ::  nbw 
     30      REAL   , POINTER, DIMENSION(:)     ::  flagu 
     31      REAL   , POINTER, DIMENSION(:)     ::  flagv 
     32   END TYPE OBC_INDEX 
     33 
     34   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
     35      REAL, POINTER, DIMENSION(:)     ::  ssh 
     36      REAL, POINTER, DIMENSION(:)     ::  u2d 
     37      REAL, POINTER, DIMENSION(:)     ::  v2d 
     38      REAL, POINTER, DIMENSION(:,:)   ::  u3d 
     39      REAL, POINTER, DIMENSION(:,:)   ::  v3d 
     40      REAL, POINTER, DIMENSION(:,:)   ::  tem 
     41      REAL, POINTER, DIMENSION(:,:)   ::  sal 
     42#if defined key_lim2 
     43      REAL, POINTER, DIMENSION(:)     ::  frld 
     44      REAL, POINTER, DIMENSION(:)     ::  hicif 
     45      REAL, POINTER, DIMENSION(:)     ::  hsnif 
     46#endif 
     47   END TYPE OBC_DATA 
     48 
    2149   !!---------------------------------------------------------------------- 
    2250   !! Namelist variables 
    2351   !!---------------------------------------------------------------------- 
    24    CHARACTER(len=80) ::   cn_mask        !: Name of unstruct. bdy mask file 
    25    CHARACTER(len=80) ::   cn_dta_frs_T   !: Name of unstruct. bdy data file at T points for FRS conditions 
    26    CHARACTER(len=80) ::   cn_dta_frs_U   !: Name of unstruct. bdy data file at U points for FRS conditions 
    27    CHARACTER(len=80) ::   cn_dta_frs_V   !: Name of unstruct. bdy data file at V points for FRS conditions 
    28    CHARACTER(len=80) ::   cn_dta_fla_T   !: Name of unstruct. bdy data file at T points for Flather scheme 
    29    CHARACTER(len=80) ::   cn_dta_fla_U   !: Name of unstruct. bdy data file at U points for Flather scheme 
    30    CHARACTER(len=80) ::   cn_dta_fla_V   !: Name of unstruct. bdy data file at V points for Flather scheme 
     52   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file 
     53   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file 
    3154   ! 
    32    LOGICAL ::   ln_tides = .false.    !: =T apply tidal harmonic forcing along open boundaries 
    33    LOGICAL ::   ln_vol  = .false.     !: =T volume correction              
    34    LOGICAL ::   ln_mask = .false.     !: =T read bdymask from file 
    35    LOGICAL ::   ln_clim = .false.     !: =T bdy data files contain  1 time dump  (-->bdy forcing will be constant)  
    36    !                                  !                         or 12 months     (-->bdy forcing will be cyclic)  
    37    LOGICAL ::   ln_dyn_fla  = .false. !: =T Flather boundary conditions on barotropic velocities 
    38    LOGICAL ::   ln_dyn_frs  = .false. !: =T FRS boundary conditions on velocities 
    39    LOGICAL ::   ln_tra_frs  = .false. !: =T FRS boundary conditions on tracers (T and S) 
    40    LOGICAL ::   ln_ice_frs  = .false. !: =T FRS boundary conditions on seaice (leads fraction, ice depth, snow depth) 
     55   LOGICAL, DIMENSION(jp_bdy) ::   ln_coords_file           !: =T read bdy coordinates from file;  
     56   !                                                        !: =F read bdy coordinates from namelist 
     57   LOGICAL                    ::   ln_mask_file             !: =T read bdymask from file 
     58   LOGICAL                    ::   ln_vol                   !: =T volume correction              
    4159   ! 
    42    INTEGER ::   nn_rimwidth = 7       !: boundary rim width 
    43    INTEGER ::   nn_dtactl   = 1       !: = 0 use the initial state as bdy dta ; = 1 read it in a NetCDF file 
    44    INTEGER ::   nn_volctl   = 1       !: = 0 the total volume will have the variability of the surface Flux E-P  
    45    !                                  !  = 1 the volume will be constant during all the integration. 
     60   INTEGER                    ::   nb_bdy                   !: number of open boundary sets 
     61   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme 
     62   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
     63   !                                                        !  = 1 the volume will be constant during all the integration. 
     64   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d                 ! Choice of boundary condition for barotropic variables (U,V,SSH) 
     65   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d_dta           !: = 0 use the initial state as bdy dta ;  
     66                                                            !: = 1 read it in a NetCDF file 
     67                                                            !: = 2 read tidal harmonic forcing from a NetCDF file 
     68                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files 
     69   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d                 ! Choice of boundary condition for baroclinic velocities  
     70   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d_dta           !: = 0 use the initial state as bdy dta ;  
     71                                                            !: = 1 read it in a NetCDF file 
     72   INTEGER, DIMENSION(jp_bdy) ::   nn_tra                   ! Choice of boundary condition for active tracers (T and S) 
     73   INTEGER, DIMENSION(jp_bdy) ::   nn_tra_dta             !: = 0 use the initial state as bdy dta ;  
     74                                                            !: = 1 read it in a NetCDF file 
     75#if defined key_lim2 
     76   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables  
     77   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2_dta          !: = 0 use the initial state as bdy dta ;  
     78                                                            !: = 1 read it in a NetCDF file 
     79#endif 
     80   ! 
     81   INTEGER, DIMENSION(jp_bdy) ::   nn_dmp2d_in              ! Damping timescale (days) for 2D solution for inward radiation or FRS  
     82   INTEGER, DIMENSION(jp_bdy) ::   nn_dmp2d_out             ! Damping timescale (days) for 2D solution for outward radiation  
     83   INTEGER, DIMENSION(jp_bdy) ::   nn_dmp3d_in              ! Damping timescale (days) for 3D solution for inward radiation or FRS  
     84   INTEGER, DIMENSION(jp_bdy) ::   nn_dmp3d_out             ! Damping timescale (days) for 3D solution for outward radiation 
    4685 
     86    
    4787   !!---------------------------------------------------------------------- 
    4888   !! Global variables 
    … …  
    5292   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyvmask   !: Mask defining computational domain at V-points 
    5393 
     94   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary 
     95 
     96   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh       !:  
     97   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur       !:  
     98   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr       !: Pointers for barotropic fields  
     99   REAL(wp), POINTER, DIMENSION(:,:)           ::   pu2d       !:  
     100   REAL(wp), POINTER, DIMENSION(:,:)           ::   pv2d       !:  
     101 
    54102   !!---------------------------------------------------------------------- 
    55    !! Unstructured open boundary data variables 
     103   !! open boundary data variables 
    56104   !!---------------------------------------------------------------------- 
    57    INTEGER, DIMENSION(jpbgrd) ::   nblen    = 0           !: Size of bdy data on a proc for each grid type 
    58    INTEGER, DIMENSION(jpbgrd) ::   nblenrim = 0           !: Size of bdy data on a proc for first rim ind 
    59    INTEGER, DIMENSION(jpbgrd) ::   nblendta = 0           !: Size of bdy data in file 
    60105 
    61    INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbi, nbj        !: i and j indices of bdy dta 
    62    INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbr             !: Discrete distance from rim points 
    63    INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbmap           !: Indices of data in file for data in memory  
    64      
    65    REAL(wp) ::   bdysurftot                               !: Lateral surface of unstructured open boundary 
    66  
    67    REAL(wp), DIMENSION(jpbdim)        ::   flagu, flagv   !: Flag for normal velocity compnt for velocity components 
    68    REAL(wp), DIMENSION(jpbdim,jpbgrd) ::   nbw            !: Rim weights of bdy data 
    69  
    70    REAL(wp), DIMENSION(jpbdim)     ::   sshbdy            !: Now clim of bdy sea surface height (Flather) 
    71    REAL(wp), DIMENSION(jpbdim)     ::   ubtbdy, vbtbdy    !: Now clim of bdy barotropic velocity components 
    72    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tbdy  , sbdy      !: Now clim of bdy temperature and salinity   
    73    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubdy  , vbdy    !: Now clim of bdy velocity components 
    74    REAL(wp), DIMENSION(jpbdim) ::   sshtide               !: Tidal boundary array : SSH 
    75    REAL(wp), DIMENSION(jpbdim) ::   utide, vtide          !: Tidal boundary array : U and V 
    76 #if defined key_lim2 
    77    REAL(wp), DIMENSION(jpbdim) ::   frld_bdy    !: now ice leads fraction climatology    
    78    REAL(wp), DIMENSION(jpbdim) ::   hicif_bdy   !: Now ice  thickness climatology 
    79    REAL(wp), DIMENSION(jpbdim) ::   hsnif_bdy   !: now snow thickness 
    80 #endif 
     106   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions 
     107                                                                          !: =1 => some data to be read in from data files 
     108   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays 
     109   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
     110   TYPE(OBC_DATA) , DIMENSION(jp_bdy)              ::   dta_bdy           !: bdy external data (local process) 
    81111 
    82112   !!---------------------------------------------------------------------- 
    … …  
    94124      !!---------------------------------------------------------------------- 
    95125      ! 
    96       ALLOCATE( bdytmask(jpi,jpj) , tbdy(jpbdim,jpk) , sbdy(jpbdim,jpk) ,     & 
    97          &      bdyumask(jpi,jpj) , ubdy(jpbdim,jpk) ,                        & 
    98          &      bdyvmask(jpi,jpj) , vbdy(jpbdim,jpk) ,                    STAT=bdy_oce_alloc ) 
     126      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),                    &   
     127         &      STAT=bdy_oce_alloc ) 
    99128         ! 
    100129      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc ) 
    … …  
    112141   !!====================================================================== 
    113142END MODULE bdy_oce 
     143 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90

    r2528 r3116  
    1717 
    1818   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .TRUE.   !: Unstructured Ocean Boundary Condition flag 
    19    INTEGER, PUBLIC, PARAMETER ::   jpbdta  = 20000    !: Max length of bdy field in file 
    20    INTEGER, PUBLIC, PARAMETER ::   jpbdim  = 20000    !: Max length of bdy field on a processor 
     19   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets 
    2120   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file 
    22    INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 6        !: Number of horizontal grid types used  (T, u, v, f) 
     21   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V) 
     22 
     23   !! Flags for choice of schemes 
     24   INTEGER, PUBLIC, PARAMETER ::   jp_none         = 0        !: Flag for no open boundary condition 
     25   INTEGER, PUBLIC, PARAMETER ::   jp_frs          = 1        !: Flag for Flow Relaxation Scheme 
     26   INTEGER, PUBLIC, PARAMETER ::   jp_flather      = 2        !: Flag for Flather 
    2327#else 
    2428   !!---------------------------------------------------------------------- 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r2977 r3116  
    1010   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations  
    1111   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
     12   !!            3.4  ???????????????? 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_bdy 
    1415   !!---------------------------------------------------------------------- 
    15    !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    16    !!---------------------------------------------------------------------- 
    17    !!   bdy_dta_frs    : read u, v, t, s data along open boundaries 
    18    !!   bdy_dta_fla : read depth-mean velocities and elevation along open boundaries         
     16   !!   'key_bdy'                     Open Boundary Conditions 
     17   !!---------------------------------------------------------------------- 
     18   !!    bdy_dta        : read external data along open boundaries from file 
     19   !!    bdy_dta_init   : initialise arrays etc for reading of external data 
    1920   !!---------------------------------------------------------------------- 
    2021   USE oce             ! ocean dynamics and tracers 
    2122   USE dom_oce         ! ocean space and time domain 
    2223   USE phycst          ! physical constants 
    23    USE bdy_oce         ! ocean open boundary conditions 
     24   USE bdy_oce         ! ocean open boundary conditions   
    2425   USE bdytides        ! tidal forcing at boundaries 
    25    USE iom 
    26    USE ioipsl 
     26   USE fldread         ! read input fields 
     27   USE iom             ! IOM library 
    2728   USE in_out_manager  ! I/O logical units 
    2829#if defined key_lim2 
    … …  
    3334   PRIVATE 
    3435 
    35    PUBLIC   bdy_dta_frs      ! routines called by step.F90 
    36    PUBLIC   bdy_dta_fla  
    37    PUBLIC   bdy_dta_alloc    ! routine called by bdy_init.F90 
    38  
    39    INTEGER ::   numbdyt, numbdyu, numbdyv                      ! logical units for T-, U-, & V-points data file, resp. 
    40    INTEGER ::   ntimes_bdy                                     ! exact number of time dumps in data files 
    41    INTEGER ::   nbdy_b, nbdy_a                                 ! record of bdy data file for before and after time step 
    42    INTEGER ::   numbdyt_bt, numbdyu_bt, numbdyv_bt             ! logical unit for T-, U- & V-points data file, resp. 
    43    INTEGER ::   ntimes_bdy_bt                                  ! exact number of time dumps in data files 
    44    INTEGER ::   nbdy_b_bt, nbdy_a_bt                           ! record of bdy data file for before and after time step 
    45  
    46    INTEGER, DIMENSION (jpbtime) ::   istep, istep_bt           ! time array in seconds in each data file 
    47  
    48    REAL(wp) ::  zoffset                                        ! time offset between time origin in file & start time of model run 
    49  
    50    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tbdydta, sbdydta   ! time interpolated values of T and S bdy data    
    51    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ubdydta, vbdydta   ! time interpolated values of U and V bdy data  
    52    REAL(wp), DIMENSION(jpbdim,2)     ::   ubtbdydta, vbtbdydta ! Arrays used for time interpolation of bdy data    
    53    REAL(wp), DIMENSION(jpbdim,2)     ::   sshbdydta            ! bdy data of ssh 
    54  
    55 #if defined key_lim2 
    56    REAL(wp), DIMENSION(jpbdim,2)     ::   frld_bdydta          ! } 
    57    REAL(wp), DIMENSION(jpbdim,2)     ::   hicif_bdydta         ! } Arrays used for time interp. of ice bdy data  
    58    REAL(wp), DIMENSION(jpbdim,2)     ::   hsnif_bdydta         ! } 
    59 #endif 
    60  
     36   PUBLIC   bdy_dta          ! routine called by step.F90 and dynspg_ts.F90 
     37   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90 
     38 
     39   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set. 
     40   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets. 
     41 
     42   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions 
     43                                                               ! =F => baroclinic velocities in 3D boundary conditions 
     44 
     45   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read) 
     46 
     47   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
     48 
     49#  include "domzgr_substitute.h90" 
    6150   !!---------------------------------------------------------------------- 
    6251   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    6655CONTAINS 
    6756 
    68   FUNCTION bdy_dta_alloc() 
    69      !!---------------------------------------------------------------------- 
    70      USE lib_mpp, ONLY: ctl_warn, mpp_sum 
    71      ! 
    72      INTEGER :: bdy_dta_alloc 
    73      !!---------------------------------------------------------------------- 
    74      ! 
    75      ALLOCATE(tbdydta(jpbdim,jpk,2), sbdydta(jpbdim,jpk,2), & 
    76               ubdydta(jpbdim,jpk,2), vbdydta(jpbdim,jpk,2), Stat=bdy_dta_alloc) 
    77  
    78      IF( lk_mpp           ) CALL mpp_sum ( bdy_dta_alloc ) 
    79      IF(bdy_dta_alloc /= 0) CALL ctl_warn('bdy_dta_alloc: failed to allocate arrays') 
    80  
    81    END FUNCTION bdy_dta_alloc 
    82  
    83  
    84    SUBROUTINE bdy_dta_frs( kt ) 
     57      SUBROUTINE bdy_dta( kt, jit, time_offset ) 
    8558      !!---------------------------------------------------------------------- 
    86       !!                   ***  SUBROUTINE bdy_dta_frs  *** 
     59      !!                   ***  SUBROUTINE bdy_dta  *** 
    8760      !!                     
    88       !! ** Purpose :   Read unstructured boundary data for FRS condition. 
     61      !! ** Purpose :   Update external data for open boundary conditions 
    8962      !! 
    90       !! ** Method  :   At the first timestep, read in boundary data for two 
    91       !!                times from the file and time-interpolate. At other  
    92       !!                timesteps, check to see if we need another time from  
    93       !!                the file. If so read it in. Time interpolate. 
     63      !! ** Method  :   Use fldread.F90 
     64      !!                 
    9465      !!---------------------------------------------------------------------- 
    95       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index (for timesplitting option, otherwise zero) 
     66      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     67      USE wrk_nemo, ONLY: wrk_2d_22, wrk_2d_23   ! 2D workspace 
    9668      !! 
    97       CHARACTER(LEN=80), DIMENSION(3) ::   clfile               ! names of input files 
    98       CHARACTER(LEN=70 )              ::   clunits              ! units attribute of time coordinate 
    99       LOGICAL ::   lect                                         ! flag for reading 
    100       INTEGER ::   it, ib, ik, igrd                             ! dummy loop indices 
    101       INTEGER ::   igrd_start, igrd_end                         ! start and end of loops on igrd 
    102       INTEGER ::   idvar                                        ! netcdf var ID 
    103       INTEGER ::   iman, i15, imois                             ! Time variables for monthly clim forcing 
    104       INTEGER ::   ntimes_bdyt, ntimes_bdyu, ntimes_bdyv 
    105       INTEGER ::   itimer, totime 
    106       INTEGER ::   ii, ij                                       ! array addresses 
    107       INTEGER ::   ipi, ipj, ipk, inum                          ! local integers (NetCDF read) 
    108       INTEGER ::   iyear0, imonth0, iday0 
    109       INTEGER ::   ihours0, iminutes0, isec0 
    110       INTEGER ::   iyear, imonth, iday, isecs 
    111       INTEGER, DIMENSION(jpbtime) ::   istept, istepu, istepv   ! time arrays from data files 
    112       REAL(wp) ::   dayfrac, zxy, zoffsett 
    113       REAL(wp) ::   zoffsetu, zoffsetv 
    114       REAL(wp) ::   dayjul0, zdayjulini 
    115       REAL(wp), DIMENSION(jpbtime)      ::   zstepr             ! REAL time array from data files 
    116       REAL(wp), DIMENSION(jpbdta,1,jpk) ::   zdta               ! temporary array for data fields 
     69      INTEGER, INTENT( in )           ::   kt    ! ocean time-step index  
     70      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     71      INTEGER, INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
     72                                                        ! is present then units = subcycle timesteps. 
     73                                                        ! time_offset = 0 => get data at "now" time level 
     74                                                        ! time_offset = -1 => get data at "before" time level 
     75                                                        ! time_offset = +1 => get data at "after" time level 
     76                                                        ! etc. 
     77      !! 
     78      INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd  ! local indices 
     79      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
     80      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
     81      !! 
    11782      !!--------------------------------------------------------------------------- 
    11883 
    119  
    120       IF( ln_dyn_frs .OR. ln_tra_frs    & 
    121          &               .OR. ln_ice_frs ) THEN  ! If these are both false then this routine does nothing 
    122  
    123       ! -------------------- ! 
    124       !    Initialization    ! 
    125       ! -------------------- ! 
    126  
    127       lect   = .false.           ! If true, read a time record 
    128  
    129       ! Some time variables for monthly climatological forcing: 
    130       ! ******************************************************* 
    131  
    132 !!gm  here  use directely daymod calendar variables 
    133   
    134       iman = INT( raamo )      ! Number of months in a year 
    135  
    136       i15 = INT( 2*REAL( nday, wp ) / ( REAL( nmonth_len(nmonth), wp ) + 0.5 ) ) 
    137       ! i15=0 if the current day is in the first half of the month, else i15=1 
    138  
    139       imois = nmonth + i15 - 1            ! imois is the first month record 
    140       IF( imois == 0 )   imois = iman 
    141  
    142       ! Time variable for non-climatological forcing: 
    143       ! ********************************************* 
    144       itimer = (kt-nit000+1)*rdt      ! current time in seconds for interpolation  
    145  
    146  
    147       !                                                !-------------------! 
    148       IF( kt == nit000 ) THEN                          !  First call only  ! 
    149          !                                             !-------------------! 
    150          istep(:) = 0 
    151          nbdy_b   = 0 
    152          nbdy_a   = 0 
    153  
    154          ! Get time information from bdy data file 
    155          ! *************************************** 
    156  
    157          IF(lwp) WRITE(numout,*) 
    158          IF(lwp) WRITE(numout,*)    'bdy_dta_frs : Initialize unstructured boundary data' 
    159          IF(lwp) WRITE(numout,*)    '~~~~~~~'  
    160  
    161          IF     ( nn_dtactl == 0 ) THEN 
    162             ! 
    163             IF(lwp) WRITE(numout,*) '          Bdy data are taken from initial conditions' 
    164             ! 
    165          ELSEIF (nn_dtactl == 1) THEN 
    166             ! 
    167             IF(lwp) WRITE(numout,*) '          Bdy data are read in netcdf files' 
    168             ! 
    169             dayfrac = adatrj  - REAL( itimer, wp ) / 86400.   ! day fraction at time step kt-1 
    170             dayfrac = dayfrac - INT ( dayfrac )               ! 
    171             totime  = ( nitend - nit000 + 1 ) * rdt           ! Total time of the run to verify that all the 
    172             !                                                 ! necessary time dumps in file are included 
    173             ! 
    174             clfile(1) = cn_dta_frs_T 
    175             clfile(2) = cn_dta_frs_U 
    176             clfile(3) = cn_dta_frs_V 
    177             !                                                   
    178             ! how many files are we to read in? 
    179             igrd_start = 1 
    180             igrd_end   = 3 
    181             IF(.NOT. ln_tra_frs .AND. .NOT. ln_ice_frs) THEN       ! No T-grid file. 
    182                igrd_start = 2 
    183             ELSEIF ( .NOT. ln_dyn_frs ) THEN                           ! No U-grid or V-grid file. 
    184                igrd_end   = 1          
    185             ENDIF 
    186  
    187             DO igrd = igrd_start, igrd_end                     !  loop over T, U & V grid  ! 
    188                !                                               !---------------------------! 
    189                CALL iom_open( clfile(igrd), inum ) 
    190                CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy, cdunits=clunits )  
    191  
    192                SELECT CASE( igrd ) 
    193                   CASE (1)   ;   numbdyt = inum 
    194                   CASE (2)   ;   numbdyu = inum 
    195                   CASE (3)   ;   numbdyv = inum 
    196                END SELECT 
    197  
    198                ! Calculate time offset  
    199                READ(clunits,7000) iyear0, imonth0, iday0, ihours0, iminutes0, isec0 
    200                ! Convert time origin in file to julian days  
    201                isec0 = isec0 + ihours0*60.*60. + iminutes0*60. 
    202                CALL ymds2ju(iyear0, imonth0, iday0, REAL(isec0, wp), dayjul0) 
    203                ! Compute model initialization time  
    204                iyear  = ndastp / 10000 
    205                imonth = ( ndastp - iyear * 10000 ) / 100 
    206                iday   = ndastp - iyear * 10000 - imonth * 100 
    207                isecs  = dayfrac * 86400 
    208                CALL ymds2ju(iyear, imonth, iday, REAL(isecs, wp) , zdayjulini) 
    209                ! offset from initialization date: 
    210                zoffset = (dayjul0-zdayjulini)*86400 
    211                ! 
    212 7000           FORMAT('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2) 
    213  
    214                !! TO BE DONE... Check consistency between calendar from file  
    215                !! (available optionally from iom_gettime) and calendar in model  
    216                !! when calendar in model available outside of IOIPSL. 
    217  
    218                IF(lwp) WRITE(numout,*) 'number of times: ',ntimes_bdy 
    219                IF(lwp) WRITE(numout,*) 'offset: ',zoffset 
    220                IF(lwp) WRITE(numout,*) 'totime: ',totime 
    221                IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr(1:ntimes_bdy) 
    222  
    223                ! Check that there are not too many times in the file.  
    224                IF( ntimes_bdy > jpbtime ) THEN 
    225                   WRITE(ctmp1,*) 'Check file: ', clfile(igrd), 'jpbtime= ', jpbtime, ' ntimes_bdy= ', ntimes_bdy 
    226                   CALL ctl_stop( 'Number of time dumps in files exceed jpbtime parameter', ctmp1 ) 
    227                ENDIF 
    228  
    229                ! Check that time array increases: 
    230                it = 1 
    231                DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 )  
    232                   it = it + 1 
    233                END DO 
    234                ! 
    235                IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN 
    236                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 
    237                      CALL ctl_stop( 'Time array in unstructured boundary data files',   & 
    238                         &           'does not continuously increase.'               , ctmp1 ) 
    239                ENDIF 
    240                ! 
    241                ! Check that times in file span model run time: 
    242                IF( zstepr(1) + zoffset > 0 ) THEN 
    243                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 
    244                      CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 ) 
    245                END IF 
    246                IF( zstepr(ntimes_bdy) + zoffset < totime ) THEN 
    247                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 
    248                      CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 ) 
    249                END IF 
    250                ! 
    251                SELECT CASE( igrd ) 
    252                   CASE (1) 
    253                     ntimes_bdyt = ntimes_bdy 
    254                     zoffsett = zoffset 
    255                     istept(:) = INT( zstepr(:) + zoffset ) 
    256                     numbdyt = inum 
    257                   CASE (2) 
    258                     ntimes_bdyu = ntimes_bdy 
    259                     zoffsetu = zoffset 
    260                     istepu(:) = INT( zstepr(:) + zoffset ) 
    261                     numbdyu = inum 
    262                   CASE (3) 
    263                     ntimes_bdyv = ntimes_bdy 
    264                     zoffsetv = zoffset 
    265                     istepv(:) = INT( zstepr(:) + zoffset ) 
    266                     numbdyv = inum 
    267                END SELECT 
    268                ! 
    269             END DO                                         ! end loop over T, U & V grid  
    270  
    271             IF (igrd_start == 1 .and. igrd_end == 3) THEN 
    272                ! Only test differences if we are reading in 3 files 
    273                ! Verify time consistency between files   
    274                IF( ntimes_bdyu /= ntimes_bdyt .OR. ntimes_bdyv /= ntimes_bdyt ) THEN 
    275                   CALL ctl_stop( 'Bdy data files must have the same number of time dumps',   & 
    276                   &           'Multiple time frequencies not implemented yet'  ) 
    277                ENDIF 
    278                ntimes_bdy = ntimes_bdyt 
    279                ! 
    280                IF( zoffsetu /= zoffsett .OR. zoffsetv /= zoffsett ) THEN 
    281                   CALL ctl_stop( 'Bdy data files must have the same time origin',   & 
    282                   &           'Multiple time frequencies not implemented yet' ) 
    283                ENDIF 
    284                zoffset = zoffsett 
    285             ENDIF 
    286  
    287             IF( igrd_start == 1 ) THEN   ;   istep(:) = istept(:) 
    288             ELSE                         ;   istep(:) = istepu(:) 
    289             ENDIF 
    290  
    291             ! Check number of time dumps:               
    292             IF( ntimes_bdy == 1 .AND. .NOT. ln_clim ) THEN 
    293               CALL ctl_stop( 'There is only one time dump in data files',   & 
    294                  &           'Choose ln_clim=.true. in namelist for constant bdy forcing.' ) 
    295             ENDIF 
    296  
    297             IF( ln_clim ) THEN 
    298               IF( ntimes_bdy /= 1 .AND. ntimes_bdy /= 12 ) THEN 
    299                  CALL ctl_stop( 'For climatological boundary forcing (ln_clim=.true.),',   & 
    300                     &           'bdy data files must contain 1 or 12 time dumps.' ) 
    301               ELSEIF( ntimes_bdy ==  1 ) THEN 
    302                 IF(lwp) WRITE(numout,*) 
    303                 IF(lwp) WRITE(numout,*) 'We assume constant boundary forcing from bdy data files' 
    304               ELSEIF( ntimes_bdy == 12 ) THEN 
    305                 IF(lwp) WRITE(numout,*) 
    306                 IF(lwp) WRITE(numout,*) 'We assume monthly (and cyclic) boundary forcing from bdy data files' 
    307               ENDIF 
    308             ENDIF 
    309  
    310             ! Find index of first record to read (before first model time).  
    311             it = 1 
    312             DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 ) 
    313                it = it + 1 
    314             END DO 
    315             nbdy_b = it 
    316             ! 
    317             IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 
    318             IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b 
    319  
    320          ENDIF ! endif (nn_dtactl == 1) 
    321  
    322  
    323          ! 1.2  Read first record in file if necessary (ie if nn_dtactl == 1) 
    324          ! ***************************************************************** 
    325  
    326          IF( nn_dtactl == 0 ) THEN      ! boundary data arrays are filled with initial conditions 
    327             ! 
    328             IF (ln_tra_frs) THEN 
    329                igrd = 1            ! T-points data  
    330                DO ib = 1, nblen(igrd) 
    331                   ii = nbi(ib,igrd) 
    332                   ij = nbj(ib,igrd) 
     84      IF(wrk_in_use(2, 22,23) ) THEN 
     85         CALL ctl_stop('bdy_dta: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
     86      END IF 
     87 
     88      ! Initialise data arrays once for all from initial conditions where required 
     89      !--------------------------------------------------------------------------- 
     90      IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN 
     91 
     92         ! Calculate depth-mean currents 
     93         !----------------------------- 
     94         pu2d => wrk_2d_22 
     95         pu2d => wrk_2d_23 
     96 
     97         pu2d(:,:) = 0.e0 
     98         pv2d(:,:) = 0.e0 
     99 
     100         DO ik = 1, jpkm1   !! Vertically integrated momentum trends 
     101             pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
     102             pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
     103         END DO 
     104         pu2d(:,:) = pu2d(:,:) * hur(:,:) 
     105         pv2d(:,:) = pv2d(:,:) * hvr(:,:) 
     106          
     107         DO ib_bdy = 1, nb_bdy 
     108 
     109            nblen => idx_bdy(ib_bdy)%nblen 
     110            nblenrim => idx_bdy(ib_bdy)%nblenrim 
     111 
     112            IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
     113               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     114                  ilen1(:) = nblen(:) 
     115               ELSE 
     116                  ilen1(:) = nblenrim(:) 
     117               ENDIF 
     118               igrd = 1 
     119               DO ib = 1, ilen1(igrd) 
     120                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     121                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     122                  dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
     123               END DO  
     124               igrd = 2 
     125               DO ib = 1, ilen1(igrd) 
     126                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     127                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     128                  dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)          
     129               END DO  
     130               igrd = 3 
     131               DO ib = 1, ilen1(igrd) 
     132                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     133                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     134                  dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)          
     135               END DO  
     136            ENDIF 
     137 
     138            IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
     139               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 
     140                  ilen1(:) = nblen(:) 
     141               ELSE 
     142                  ilen1(:) = nblenrim(:) 
     143               ENDIF 
     144               igrd = 2  
     145               DO ib = 1, ilen1(igrd) 
    333146                  DO ik = 1, jpkm1 
    334                      tbdy(ib,ik) = tsn(ii,ij,ik,jp_tem) 
    335                      sbdy(ib,ik) = tsn(ii,ij,ik,jp_sal) 
     147                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     148                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     149                     dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)          
     150                  END DO 
     151               END DO  
     152               igrd = 3  
     153               DO ib = 1, ilen1(igrd) 
     154                  DO ik = 1, jpkm1 
     155                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     156                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     157                     dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik)          
     158                     END DO 
     159               END DO  
     160            ENDIF 
     161 
     162            IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
     163               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 
     164                  ilen1(:) = nblen(:) 
     165               ELSE 
     166                  ilen1(:) = nblenrim(:) 
     167               ENDIF 
     168               igrd = 1                       ! Everything is at T-points here 
     169               DO ib = 1, ilen1(igrd) 
     170                  DO ik = 1, jpkm1 
     171                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     172                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     173                     dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
     174                     dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
     175                  END DO 
     176               END DO  
     177            ENDIF 
     178 
     179#if defined key_lim2 
     180            IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
     181               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     182                  ilen1(:) = nblen(:) 
     183               ELSE 
     184                  ilen1(:) = nblenrim(:) 
     185               ENDIF 
     186               igrd = 1                       ! Everything is at T-points here 
     187               DO ib = 1, ilen1(igrd) 
     188                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     189                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     190                  dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
     191                  dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
     192                  dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
     193               END DO  
     194            ENDIF 
     195#endif 
     196 
     197         ENDDO ! ib_bdy 
     198 
     199      ENDIF ! kt .eq. nit000 
     200 
     201      ! update external data from files 
     202      !-------------------------------- 
     203      
     204      jstart = 1 
     205      DO ib_bdy = 1, nb_bdy    
     206         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 
     207       
     208            IF( PRESENT(jit) ) THEN 
     209               ! Update barotropic boundary conditions only 
     210               ! jit is optional argument for fld_read and tide_update 
     211               IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     212                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     213                     dta_bdy(ib_bdy)%ssh(:) = 0.0 
     214                     dta_bdy(ib_bdy)%u2d(:) = 0.0 
     215                     dta_bdy(ib_bdy)%v2d(:) = 0.0 
     216                  ENDIF 
     217                  IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN ! update external data 
     218                     jend = jstart + 2 
     219                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit, time_offset=time_offset ) 
     220                  ENDIF 
     221                  IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
     222                     CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), jit=jit, time_offset=time_offset ) 
     223                  ENDIF 
     224               ENDIF 
     225            ELSE 
     226               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     227                  dta_bdy(ib_bdy)%ssh(:) = 0.0 
     228                  dta_bdy(ib_bdy)%u2d(:) = 0.0 
     229                  dta_bdy(ib_bdy)%v2d(:) = 0.0 
     230               ENDIF 
     231               IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data 
     232                  jend = jstart + nb_bdy_fld(ib_bdy) - 1 
     233                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), time_offset=time_offset ) 
     234               ENDIF 
     235               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
     236                  CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), time_offset=time_offset ) 
     237               ENDIF 
     238            ENDIF 
     239            jstart = jend+1 
     240 
     241            ! If full velocities in boundary data then split into barotropic and baroclinic data 
     242            ! (Note that we have already made sure that you can't use ln_full_vel = .true. at the same 
     243            ! time as the dynspg_ts option).  
     244 
     245            IF( ln_full_vel_array(ib_bdy) .and.                                             &  
     246           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 .or. nn_dyn3d_dta(ib_bdy) .eq. 1 ) ) THEN  
     247 
     248               igrd = 2                      ! zonal velocity 
     249               dta_bdy(ib_bdy)%u2d(:) = 0.0 
     250               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
     251                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     252                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     253                  DO ik = 1, jpkm1 
     254                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
     255              &                                + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     256                  END DO 
     257                  dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
     258                  DO ik = 1, jpkm1 
     259                     dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)  
    336260                  END DO 
    337261               END DO 
    338             ENDIF 
    339  
    340             IF(ln_dyn_frs) THEN 
    341                igrd = 2            ! U-points data  
    342                DO ib = 1, nblen(igrd) 
    343                   ii = nbi(ib,igrd) 
    344                   ij = nbj(ib,igrd) 
     262 
     263               igrd = 3                      ! meridional velocity 
     264               dta_bdy(ib_bdy)%v2d(:) = 0.0 
     265               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
     266                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     267                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    345268                  DO ik = 1, jpkm1 
    346                      ubdy(ib,ik) = un(ii, ij, ik) 
     269                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
     270              &                                + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     271                  END DO 
     272                  dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
     273                  DO ik = 1, jpkm1 
     274                     dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)  
    347275                  END DO 
    348276               END DO 
    349                ! 
    350                igrd = 3            ! V-points data  
    351                DO ib = 1, nblen(igrd)             
    352                   ii = nbi(ib,igrd) 
    353                   ij = nbj(ib,igrd) 
    354                   DO ik = 1, jpkm1 
    355                      vbdy(ib,ik) = vn(ii, ij, ik) 
    356                   END DO 
    357                END DO 
    358             ENDIF 
    359             ! 
    360 #if defined key_lim2 
    361             IF( ln_ice_frs ) THEN 
    362                igrd = 1            ! T-points data 
    363                DO ib = 1, nblen(igrd) 
    364                   frld_bdy (ib) =  frld(nbi(ib,igrd), nbj(ib,igrd)) 
    365                   hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd)) 
    366                   hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd)) 
    367                END DO 
    368             ENDIF 
    369 #endif 
    370          ELSEIF( nn_dtactl == 1 ) THEN    ! Set first record in the climatological case:    
    371             ! 
    372             IF( ln_clim .AND. ntimes_bdy == 1 ) THEN 
    373                nbdy_a = 1 
    374             ELSEIF( ln_clim .AND. ntimes_bdy == iman ) THEN 
    375                nbdy_b = 0 
    376                nbdy_a = imois 
     277     
     278            ENDIF 
     279 
     280         END IF ! nn_dta(ib_bdy) = 1 
     281      END DO  ! ib_bdy 
     282 
     283      IF(wrk_not_released(2, 22,23) )    CALL ctl_stop('bdy_dta: ERROR: failed to release workspace arrays.') 
     284 
     285      END SUBROUTINE bdy_dta 
     286 
     287 
     288      SUBROUTINE bdy_dta_init 
     289      !!---------------------------------------------------------------------- 
     290      !!                   ***  SUBROUTINE bdy_dta_init  *** 
     291      !!                     
     292      !! ** Purpose :   Initialise arrays for reading of external data  
     293      !!                for open boundary conditions 
     294      !! 
     295      !! ** Method  :   Use fldread.F90 
     296      !!                 
     297      !!---------------------------------------------------------------------- 
     298      USE dynspg_oce, ONLY: lk_dynspg_ts 
     299      !! 
     300      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices 
     301      !! 
     302      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
     303      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files 
     304      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data 
     305                                                                ! =F => baroclinic velocities in 3D boundary data 
     306      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays 
     307      INTEGER,              DIMENSION(jpbgrd) ::  ilen0         ! size of local arrays 
     308      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays 
     309      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld 
     310      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
     311      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
     312      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
     313      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
     314      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
     315#if defined key_lim2 
     316      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      ! 
     317#endif 
     318      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
     319#if defined key_lim2 
     320      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 
     321#endif 
     322      NAMELIST/nambdy_dta/ ln_full_vel 
     323      !!--------------------------------------------------------------------------- 
     324 
     325      ! Set nn_dta 
     326      DO ib_bdy = 1, nb_bdy 
     327         nn_dta(ib_bdy) = MAX(  nn_dyn2d_dta(ib_bdy)       & 
     328                               ,nn_dyn3d_dta(ib_bdy)       & 
     329                               ,nn_tra_dta(ib_bdy)         & 
     330#if defined key_ice_lim2 
     331                               ,nn_ice_lim2_dta(ib_bdy)    & 
     332#endif 
     333                              ) 
     334         IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1 
     335      END DO 
     336 
     337      ! Work out upper bound of how many fields there are to read in and allocate arrays 
     338      ! --------------------------------------------------------------------------- 
     339      ALLOCATE( nb_bdy_fld(nb_bdy) ) 
     340      nb_bdy_fld(:) = 0 
     341      DO ib_bdy = 1, nb_bdy          
     342         IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
     343            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
     344         ENDIF 
     345         IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
     346            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
     347         ENDIF 
     348         IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
     349            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
     350         ENDIF 
     351#if defined key_lim2 
     352         IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
     353            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
     354         ENDIF 
     355#endif                
     356      ENDDO             
     357 
     358      nb_bdy_fld_sum = SUM( nb_bdy_fld ) 
     359 
     360      ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror ) 
     361      IF( ierror > 0 ) THEN    
     362         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN   
     363      ENDIF 
     364      ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror ) 
     365      IF( ierror > 0 ) THEN    
     366         CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' )   ;   RETURN   
     367      ENDIF 
     368      ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror ) 
     369      IF( ierror > 0 ) THEN    
     370         CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN   
     371      ENDIF 
     372      ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )  
     373      ALLOCATE( ibdy(nb_bdy_fld_sum) )  
     374      ALLOCATE( igrid(nb_bdy_fld_sum) )  
     375 
     376      ! Read namelists 
     377      ! -------------- 
     378      REWIND(numnam) 
     379      jfld = 0  
     380      DO ib_bdy = 1, nb_bdy          
     381         IF( nn_dta(ib_bdy) .eq. 1 ) THEN 
     382            ! set file information 
     383            cn_dir = './'        ! directory in which the model is executed 
     384            ln_full_vel = .false. 
     385            ! ... default values (NB: frequency positive => hours, negative => months) 
     386            !                    !  file       ! frequency !  variable        ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
     387            !                    !  name       !  (hours)  !   name           !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
     388            bn_ssh     = FLD_N(  'bdy_ssh'     ,    24     ,  'sossheig'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     389            bn_u2d     = FLD_N(  'bdy_vel2d_u' ,    24     ,  'vobtcrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     390            bn_v2d     = FLD_N(  'bdy_vel2d_v' ,    24     ,  'vobtcrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     391            bn_u3d     = FLD_N(  'bdy_vel3d_u' ,    24     ,  'vozocrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     392            bn_v3d     = FLD_N(  'bdy_vel3d_v' ,    24     ,  'vomecrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     393            bn_tem     = FLD_N(  'bdy_tem'     ,    24     ,  'votemper'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     394            bn_sal     = FLD_N(  'bdy_sal'     ,    24     ,  'vosaline'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     395#if defined key_lim2 
     396            bn_frld    = FLD_N(  'bdy_frld'    ,    24     ,  'ildsconc'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     397            bn_hicif   = FLD_N(  'bdy_hicif'   ,    24     ,  'iicethic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     398            bn_hsnif   = FLD_N(  'bdy_hsnif'   ,    24     ,  'isnothic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     399#endif 
     400 
     401            ! Important NOT to rewind here. 
     402            READ( numnam, nambdy_dta ) 
     403 
     404            cn_dir_array(ib_bdy) = cn_dir 
     405            ln_full_vel_array(ib_bdy) = ln_full_vel 
     406 
     407            IF( ln_full_vel_array(ib_bdy) .and. lk_dynspg_ts )  THEN 
     408               CALL ctl_stop( 'bdy_dta_init: ERROR, cannot specify full velocities in boundary data',& 
     409            &                  'with dynspg_ts option' )   ;   RETURN   
     410            ENDIF              
     411 
     412            nblen => idx_bdy(ib_bdy)%nblen 
     413            nblenrim => idx_bdy(ib_bdy)%nblenrim 
     414 
     415            ! Only read in necessary fields for this set. 
     416            ! Important that barotropic variables come first. 
     417            IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN  
     418 
     419               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 
     420                  jfld = jfld + 1 
     421                  blf_i(jfld) = bn_ssh 
     422                  ibdy(jfld) = ib_bdy 
     423                  igrid(jfld) = 1 
     424                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     425                  ilen3(jfld) = 1 
     426               ENDIF 
     427 
     428               IF( .not. ln_full_vel_array(ib_bdy) ) THEN 
     429 
     430                  jfld = jfld + 1 
     431                  blf_i(jfld) = bn_u2d 
     432                  ibdy(jfld) = ib_bdy 
     433                  igrid(jfld) = 2 
     434                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     435                     ilen1(jfld) = nblen(igrid(jfld)) 
     436                  ELSE 
     437                     ilen1(jfld) = nblenrim(igrid(jfld)) 
     438                  ENDIF 
     439                  ilen3(jfld) = 1 
     440 
     441                  jfld = jfld + 1 
     442                  blf_i(jfld) = bn_v2d 
     443                  ibdy(jfld) = ib_bdy 
     444                  igrid(jfld) = 3 
     445                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     446                     ilen1(jfld) = nblen(igrid(jfld)) 
     447                  ELSE 
     448                     ilen1(jfld) = nblenrim(igrid(jfld)) 
     449                  ENDIF 
     450                  ilen3(jfld) = 1 
     451 
     452               ENDIF 
     453 
     454            ENDIF 
     455 
     456            ! baroclinic velocities 
     457            IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 
     458           &      ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.  & 
     459           &        ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     460 
     461               jfld = jfld + 1 
     462               blf_i(jfld) = bn_u3d 
     463               ibdy(jfld) = ib_bdy 
     464               igrid(jfld) = 2 
     465               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 
     466                  ilen1(jfld) = nblen(igrid(jfld)) 
     467               ELSE 
     468                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     469               ENDIF 
     470               ilen3(jfld) = jpk 
     471 
     472               jfld = jfld + 1 
     473               blf_i(jfld) = bn_v3d 
     474               ibdy(jfld) = ib_bdy 
     475               igrid(jfld) = 3 
     476               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 
     477                  ilen1(jfld) = nblen(igrid(jfld)) 
     478               ELSE 
     479                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     480               ENDIF 
     481               ilen3(jfld) = jpk 
     482 
     483            ENDIF 
     484 
     485            ! temperature and salinity 
     486            IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
     487 
     488               jfld = jfld + 1 
     489               blf_i(jfld) = bn_tem 
     490               ibdy(jfld) = ib_bdy 
     491               igrid(jfld) = 1 
     492               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 
     493                  ilen1(jfld) = nblen(igrid(jfld)) 
     494               ELSE 
     495                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     496               ENDIF 
     497               ilen3(jfld) = jpk 
     498 
     499               jfld = jfld + 1 
     500               blf_i(jfld) = bn_sal 
     501               ibdy(jfld) = ib_bdy 
     502               igrid(jfld) = 1 
     503               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 
     504                  ilen1(jfld) = nblen(igrid(jfld)) 
     505               ELSE 
     506                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     507               ENDIF 
     508               ilen3(jfld) = jpk 
     509 
     510            ENDIF 
     511 
     512#if defined key_lim2 
     513            ! sea ice 
     514            IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
     515 
     516               jfld = jfld + 1 
     517               blf_i(jfld) = bn_frld 
     518               ibdy(jfld) = ib_bdy 
     519               igrid(jfld) = 1 
     520               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     521                  ilen1(jfld) = nblen(igrid(jfld)) 
     522               ELSE 
     523                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     524               ENDIF 
     525               ilen3(jfld) = 1 
     526 
     527               jfld = jfld + 1 
     528               blf_i(jfld) = bn_hicif 
     529               ibdy(jfld) = ib_bdy 
     530               igrid(jfld) = 1 
     531               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     532                  ilen1(jfld) = nblen(igrid(jfld)) 
     533               ELSE 
     534                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     535               ENDIF 
     536               ilen3(jfld) = 1 
     537 
     538               jfld = jfld + 1 
     539               blf_i(jfld) = bn_hsnif 
     540               ibdy(jfld) = ib_bdy 
     541               igrid(jfld) = 1 
     542               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     543                  ilen1(jfld) = nblen(igrid(jfld)) 
     544               ELSE 
     545                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     546               ENDIF 
     547               ilen3(jfld) = 1 
     548 
     549            ENDIF 
     550#endif 
     551            ! Recalculate field counts 
     552            !------------------------- 
     553            nb_bdy_fld_sum = 0 
     554            IF( ib_bdy .eq. 1 ) THEN  
     555               nb_bdy_fld(ib_bdy) = jfld 
     556               nb_bdy_fld_sum     = jfld               
    377557            ELSE 
    378                nbdy_a = nbdy_b 
    379             ENDIF 
    380     
    381             ! Read first record: 
    382             ipj  = 1 
    383             ipk  = jpk 
    384             igrd = 1 
    385             ipi  = nblendta(igrd) 
    386  
    387             IF(ln_tra_frs) THEN 
    388                ! 
    389                igrd = 1                                           ! Temperature 
    390                IF( nblendta(igrd) <=  0 ) THEN  
    391                   idvar = iom_varid( numbdyt, 'votemper' ) 
    392                   nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 
    393                ENDIF 
    394                IF(lwp) WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd) 
    395                ipi = nblendta(igrd) 
    396                CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 
    397                ! 
    398                DO ib = 1, nblen(igrd) 
    399                   DO ik = 1, jpkm1 
    400                      tbdydta(ib,ik,2) =  zdta(nbmap(ib,igrd),1,ik) 
    401                   END DO 
    402                END DO 
    403                ! 
    404                igrd = 1                                           ! salinity 
    405                IF( nblendta(igrd) .le. 0 ) THEN  
    406                   idvar = iom_varid( numbdyt, 'vosaline' ) 
    407                   nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 
    408                ENDIF 
    409                IF(lwp) WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd) 
    410                ipi = nblendta(igrd) 
    411                CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 
    412                ! 
    413                DO ib = 1, nblen(igrd) 
    414                   DO ik = 1, jpkm1 
    415                      sbdydta(ib,ik,2) =  zdta(nbmap(ib,igrd),1,ik) 
    416                   END DO 
    417                END DO 
    418             ENDIF  ! ln_tra_frs 
    419   
    420             IF( ln_dyn_frs ) THEN 
    421                ! 
    422                igrd = 2                                           ! u-velocity 
    423                IF ( nblendta(igrd) .le. 0 ) THEN  
    424                  idvar = iom_varid( numbdyu,'vozocrtx' ) 
    425                  nblendta(igrd) = iom_file(numbdyu)%dimsz(1,idvar) 
    426                ENDIF 
    427                IF(lwp) WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd) 
    428                ipi = nblendta(igrd) 
    429                CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 
    430                DO ib = 1, nblen(igrd) 
    431                   DO ik = 1, jpkm1 
    432                      ubdydta(ib,ik,2) =  zdta(nbmap(ib,igrd),1,ik) 
    433                   END DO 
    434                END DO 
    435                ! 
    436                igrd = 3                                           ! v-velocity 
    437                IF ( nblendta(igrd) .le. 0 ) THEN  
    438                  idvar = iom_varid( numbdyv,'vomecrty' ) 
    439                  nblendta(igrd) = iom_file(numbdyv)%dimsz(1,idvar) 
    440                ENDIF 
    441                IF(lwp) WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd) 
    442                ipi = nblendta(igrd) 
    443                CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 
    444                DO ib = 1, nblen(igrd) 
    445                   DO ik = 1, jpkm1 
    446                      vbdydta(ib,ik,2) =  zdta(nbmap(ib,igrd),1,ik) 
    447                   END DO 
    448                END DO 
    449             ENDIF ! ln_dyn_frs 
    450  
    451 #if defined key_lim2 
    452             IF( ln_ice_frs ) THEN 
    453               ! 
    454               igrd=1                                              ! leads fraction 
    455               IF(lwp) WRITE(numout,*) 'Dim size for ildsconc is ',nblendta(igrd) 
    456               ipi=nblendta(igrd) 
    457               CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 
    458               DO ib=1, nblen(igrd) 
    459                 frld_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1) 
    460               END DO 
    461               ! 
    462               igrd=1                                              ! ice thickness 
    463               IF(lwp) WRITE(numout,*) 'Dim size for iicethic is ',nblendta(igrd) 
    464               ipi=nblendta(igrd) 
    465               CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 
    466               DO ib=1, nblen(igrd) 
    467                 hicif_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1) 
    468               END DO 
    469               ! 
    470               igrd=1                                              ! snow thickness 
    471               IF(lwp) WRITE(numout,*) 'Dim size for isnowthi is ',nblendta(igrd) 
    472               ipi=nblendta(igrd) 
    473               CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 
    474               DO ib=1, nblen(igrd) 
    475                 hsnif_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1) 
    476               END DO 
    477             ENDIF ! just if ln_ice_frs is set 
    478 #endif 
    479  
    480             IF( .NOT.ln_clim .AND. istep(1) > 0 ) THEN     ! First data time is after start of run 
    481                nbdy_b = nbdy_a                                 ! Put first value in both time levels 
    482                IF( ln_tra_frs ) THEN 
    483                  tbdydta(:,:,1) = tbdydta(:,:,2) 
    484                  sbdydta(:,:,1) = sbdydta(:,:,2) 
    485                ENDIF 
    486                IF( ln_dyn_frs ) THEN 
    487                  ubdydta(:,:,1) = ubdydta(:,:,2) 
    488                  vbdydta(:,:,1) = vbdydta(:,:,2) 
    489                ENDIF 
    490 #if defined key_lim2 
    491                IF( ln_ice_frs ) THEN 
    492                   frld_bdydta (:,1) =  frld_bdydta(:,2) 
    493                   hicif_bdydta(:,1) = hicif_bdydta(:,2) 
    494                   hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 
    495                ENDIF 
    496 #endif 
    497             END IF 
    498             ! 
    499          END IF   ! nn_dtactl == 0/1 
    500   
    501          ! In the case of constant boundary forcing fill bdy arrays once for all 
    502          IF( ln_clim .AND. ntimes_bdy == 1 ) THEN 
    503             IF( ln_tra_frs ) THEN 
    504                tbdy  (:,:) = tbdydta  (:,:,2) 
    505                sbdy  (:,:) = sbdydta  (:,:,2) 
    506             ENDIF 
    507             IF( ln_dyn_frs) THEN 
    508                ubdy  (:,:) = ubdydta  (:,:,2) 
    509                vbdy  (:,:) = vbdydta  (:,:,2) 
    510             ENDIF 
    511 #if defined key_lim2 
    512             IF( ln_ice_frs ) THEN 
    513                frld_bdy (:) = frld_bdydta (:,2) 
    514                hicif_bdy(:) = hicif_bdydta(:,2) 
    515                hsnif_bdy(:) = hsnif_bdydta(:,2) 
    516             ENDIF 
    517 #endif 
    518  
    519             IF( ln_tra_frs .OR. ln_ice_frs) CALL iom_close( numbdyt ) 
    520             IF( ln_dyn_frs                    ) CALL iom_close( numbdyu ) 
    521             IF( ln_dyn_frs                    ) CALL iom_close( numbdyv ) 
    522          END IF 
    523          ! 
    524       ENDIF                                            ! End if nit000 
    525  
    526  
    527       !                                                !---------------------! 
    528       IF( nn_dtactl == 1 .AND. ntimes_bdy > 1 ) THEN    !  at each time step  ! 
    529          !                                             !---------------------! 
    530          ! Read one more record if necessary 
    531          !********************************** 
    532  
    533          IF( ln_clim .AND. imois /= nbdy_b ) THEN      ! remember that nbdy_b=0 for kt=nit000 
    534             nbdy_b = imois 
    535             nbdy_a = imois + 1 
    536             nbdy_b = MOD( nbdy_b, iman )   ;   IF( nbdy_b == 0 ) nbdy_b = iman 
    537             nbdy_a = MOD( nbdy_a, iman )   ;   IF( nbdy_a == 0 ) nbdy_a = iman 
    538             lect=.true. 
    539          ELSEIF( .NOT.ln_clim .AND. itimer >= istep(nbdy_a) ) THEN 
    540  
    541             IF( nbdy_a < ntimes_bdy ) THEN 
    542                nbdy_b = nbdy_a 
    543                nbdy_a = nbdy_a + 1 
    544                lect  =.true. 
     558               nb_bdy_fld(ib_bdy) = jfld - nb_bdy_fld_sum 
     559               nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(ib_bdy) 
     560            ENDIF 
     561 
     562         ENDIF ! nn_dta .eq. 1 
     563      ENDDO ! ib_bdy 
     564 
     565 
     566      DO jfld = 1, nb_bdy_fld_sum 
     567         ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 
     568         IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 
     569         nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld)) 
     570      ENDDO 
     571 
     572      ! fill bf with blf_i and control print 
     573      !------------------------------------- 
     574      jstart = 1 
     575      DO ib_bdy = 1, nb_bdy 
     576         jend = jstart + nb_bdy_fld(ib_bdy) - 1 
     577         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta', 'open boundary conditions', 'nambdy_dta' ) 
     578         jstart = jend + 1 
     579      ENDDO 
     580 
     581      ! Initialise local boundary data arrays 
     582      ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 
     583      ! nn_xxx_dta=1 : point to "fnow" arrays 
     584      !------------------------------------- 
     585 
     586      jfld = 0 
     587      DO ib_bdy=1, nb_bdy 
     588 
     589         nblen => idx_bdy(ib_bdy)%nblen 
     590         nblenrim => idx_bdy(ib_bdy)%nblenrim 
     591 
     592         IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 
     593            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 
     594               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     595                  ilen0(1:3) = nblen(1:3) 
     596               ELSE 
     597                  ilen0(1:3) = nblenrim(1:3) 
     598               ENDIF 
     599               ALLOCATE( dta_bdy(ib_bdy)%ssh(ilen0(1)) ) 
     600               ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 
     601               ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 
    545602            ELSE 
    546                ! We have reached the end of the file 
    547                ! put the last data time into both time levels 
    548                nbdy_b = nbdy_a 
    549                IF(ln_tra_frs) THEN 
    550                   tbdydta(:,:,1) =  tbdydta(:,:,2) 
    551                   sbdydta(:,:,1) =  sbdydta(:,:,2) 
    552                ENDIF 
    553                IF(ln_dyn_frs) THEN 
    554                   ubdydta(:,:,1) =  ubdydta(:,:,2) 
    555                   vbdydta(:,:,1) =  vbdydta(:,:,2) 
    556                ENDIF 
    557 #if defined key_lim2 
    558                IF(ln_ice_frs) THEN 
    559                   frld_bdydta (:,1) =  frld_bdydta (:,2) 
    560                   hicif_bdydta(:,1) =  hicif_bdydta(:,2) 
    561                   hsnif_bdydta(:,1) =  hsnif_bdydta(:,2) 
    562                ENDIF 
    563 #endif 
    564             END IF ! nbdy_a < ntimes_bdy 
    565             ! 
    566         END IF 
    567           
    568         IF( lect ) THEN           ! Swap arrays 
    569            IF( ln_tra_frs ) THEN 
    570              tbdydta(:,:,1) =  tbdydta(:,:,2) 
    571              sbdydta(:,:,1) =  sbdydta(:,:,2) 
    572            ENDIF 
    573            IF( ln_dyn_frs ) THEN 
    574              ubdydta(:,:,1) =  ubdydta(:,:,2) 
    575              vbdydta(:,:,1) =  vbdydta(:,:,2) 
    576            ENDIF 
    577 #if defined key_lim2 
    578            IF( ln_ice_frs ) THEN 
    579              frld_bdydta (:,1) =  frld_bdydta (:,2) 
    580              hicif_bdydta(:,1) =  hicif_bdydta(:,2) 
    581              hsnif_bdydta(:,1) =  hsnif_bdydta(:,2) 
    582            ENDIF 
    583 #endif  
    584            ! read another set 
    585            ipj  = 1 
    586            ipk  = jpk 
    587  
    588            IF( ln_tra_frs ) THEN 
    589               !  
    590               igrd = 1                                   ! temperature 
    591               ipi  = nblendta(igrd) 
    592               CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 
    593               DO ib = 1, nblen(igrd) 
    594                  DO ik = 1, jpkm1 
    595                     tbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 
    596                  END DO 
    597               END DO 
    598               ! 
    599               igrd = 1                                   ! salinity 
    600               ipi  = nblendta(igrd) 
    601               CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 
    602               DO ib = 1, nblen(igrd) 
    603                  DO ik = 1, jpkm1 
    604                     sbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 
    605                  END DO 
    606               END DO 
    607            ENDIF ! ln_tra_frs 
    608  
    609            IF(ln_dyn_frs) THEN 
    610               ! 
    611               igrd = 2                                   ! u-velocity 
    612               ipi  = nblendta(igrd) 
    613               CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 
    614               DO ib = 1, nblen(igrd) 
    615                 DO ik = 1, jpkm1 
    616                   ubdydta(ib,ik,2) =  zdta(nbmap(ib,igrd),1,ik) 
    617                 END DO 
    618               END DO 
    619               ! 
    620               igrd = 3                                   ! v-velocity 
    621               ipi  = nblendta(igrd) 
    622               CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 
    623               DO ib = 1, nblen(igrd) 
    624                  DO ik = 1, jpkm1 
    625                     vbdydta(ib,ik,2) =  zdta(nbmap(ib,igrd),1,ik) 
    626                  END DO 
    627               END DO 
    628            ENDIF ! ln_dyn_frs 
    629            ! 
    630 #if defined key_lim2 
    631            IF(ln_ice_frs) THEN 
    632              ! 
    633              igrd = 1                                    ! ice concentration 
    634              ipi=nblendta(igrd) 
    635              CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 
    636              DO ib=1, nblen(igrd) 
    637                frld_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 ) 
    638              END DO 
    639              ! 
    640              igrd=1                                      ! ice thickness 
    641              ipi=nblendta(igrd) 
    642              CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 
    643              DO ib=1, nblen(igrd) 
    644                hicif_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 ) 
    645              END DO 
    646              ! 
    647              igrd=1                                      ! snow thickness 
    648              ipi=nblendta(igrd) 
    649              CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 
    650              DO ib=1, nblen(igrd) 
    651                hsnif_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 ) 
    652              END DO 
    653            ENDIF ! ln_ice_frs 
    654 #endif 
    655            ! 
    656            IF(lwp) WRITE(numout,*) 'bdy_dta_frs : first record file used nbdy_b ',nbdy_b 
    657            IF(lwp) WRITE(numout,*) '~~~~~~~~  last  record file used nbdy_a ',nbdy_a 
    658            IF (.NOT.ln_clim) THEN 
    659               IF(lwp) WRITE(numout,*) 'first  record time (s): ', istep(nbdy_b) 
    660               IF(lwp) WRITE(numout,*) 'model time (s)        : ', itimer 
    661               IF(lwp) WRITE(numout,*) 'second record time (s): ', istep(nbdy_a) 
    662            ENDIF 
    663            ! 
    664        ENDIF ! end lect=.true. 
    665  
    666  
    667        ! Interpolate linearly 
    668        ! ******************** 
    669        !  
    670        IF( ln_clim ) THEN   ;   zxy = REAL( nday                   ) / REAL( nmonth_len(nbdy_b) ) + 0.5 - i15 
    671        ELSEIF( istep(nbdy_b) == istep(nbdy_a) ) THEN  
    672                                     zxy = 0.0_wp 
    673        ELSE                     ;   zxy = REAL( istep(nbdy_b) - itimer ) / REAL( istep(nbdy_b) - istep(nbdy_a) ) 
    674        END IF 
    675  
    676           IF(ln_tra_frs) THEN 
    677              igrd = 1                                   ! temperature & salinity 
    678              DO ib = 1, nblen(igrd) 
    679                DO ik = 1, jpkm1 
    680                  tbdy(ib,ik) = zxy * tbdydta(ib,ik,2) + (1.-zxy) * tbdydta(ib,ik,1) 
    681                  sbdy(ib,ik) = zxy * sbdydta(ib,ik,2) + (1.-zxy) * sbdydta(ib,ik,1) 
    682                END DO 
    683              END DO 
    684           ENDIF 
    685  
    686           IF(ln_dyn_frs) THEN 
    687              igrd = 2                                   ! u-velocity 
    688              DO ib = 1, nblen(igrd) 
    689                DO ik = 1, jpkm1 
    690                  ubdy(ib,ik) = zxy * ubdydta(ib,ik,2) + (1.-zxy) * ubdydta(ib,ik,1)    
    691                END DO 
    692              END DO 
    693              ! 
    694              igrd = 3                                   ! v-velocity 
    695              DO ib = 1, nblen(igrd) 
    696                DO ik = 1, jpkm1 
    697                  vbdy(ib,ik) = zxy * vbdydta(ib,ik,2) + (1.-zxy) * vbdydta(ib,ik,1)    
    698                END DO 
    699              END DO 
    700           ENDIF 
    701  
    702 #if defined key_lim2 
    703           IF(ln_ice_frs) THEN 
    704             igrd=1 
    705             DO ib=1, nblen(igrd) 
    706                frld_bdy(ib) = zxy *  frld_bdydta(ib,2) + (1.-zxy) *  frld_bdydta(ib,1) 
    707               hicif_bdy(ib) = zxy * hicif_bdydta(ib,2) + (1.-zxy) * hicif_bdydta(ib,1) 
    708               hsnif_bdy(ib) = zxy * hsnif_bdydta(ib,2) + (1.-zxy) * hsnif_bdydta(ib,1) 
    709             END DO 
    710           ENDIF ! just if ln_ice_frs is true 
    711 #endif 
    712  
    713       END IF                       !end if ((nn_dtactl==1).AND.(ntimes_bdy>1)) 
    714      
    715  
    716       !                                                !---------------------! 
    717       !                                                !     last call       ! 
    718       !                                                !---------------------! 
    719       IF( kt == nitend ) THEN 
    720           IF(ln_tra_frs .or. ln_ice_frs) CALL iom_close( numbdyt )              ! Closing of the 3 files 
    721           IF(ln_dyn_frs) CALL iom_close( numbdyu ) 
    722           IF(ln_dyn_frs) CALL iom_close( numbdyv ) 
    723       ENDIF 
    724       ! 
    725       ENDIF ! ln_dyn_frs .OR. ln_tra_frs 
    726       ! 
    727    END SUBROUTINE bdy_dta_frs 
    728  
    729  
    730    SUBROUTINE bdy_dta_fla( kt, jit, icycl ) 
    731       !!--------------------------------------------------------------------------- 
    732       !!                      ***  SUBROUTINE bdy_dta_fla  *** 
    733       !!                     
    734       !! ** Purpose :   Read unstructured boundary data for Flather condition 
    735       !! 
    736       !! ** Method  :  At the first timestep, read in boundary data for two 
    737       !!               times from the file and time-interpolate. At other  
    738       !!               timesteps, check to see if we need another time from  
    739       !!               the file. If so read it in. Time interpolate. 
    740       !!--------------------------------------------------------------------------- 
    741 !!gm DOCTOR names :   argument integer :  start with "k" 
    742       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    743       INTEGER, INTENT( in ) ::   jit         ! barotropic time step index 
    744       INTEGER, INTENT( in ) ::   icycl       ! number of cycles need for final file close 
    745       !                                      ! (for timesplitting option, otherwise zero) 
    746       !! 
    747       LOGICAL ::   lect                      ! flag for reading 
    748       INTEGER ::   it, ib, igrd              ! dummy loop indices 
    749       INTEGER ::   idvar                     ! netcdf var ID 
    750       INTEGER ::   iman, i15, imois          ! Time variables for monthly clim forcing 
    751       INTEGER ::   ntimes_bdyt, ntimes_bdyu, ntimes_bdyv 
    752       INTEGER ::   itimer, totime 
    753       INTEGER ::   ipi, ipj, ipk, inum       ! temporary integers (NetCDF read) 
    754       INTEGER ::   iyear0, imonth0, iday0 
    755       INTEGER ::   ihours0, iminutes0, isec0 
    756       INTEGER ::   iyear, imonth, iday, isecs 
    757       INTEGER, DIMENSION(jpbtime) ::   istept, istepu, istepv   ! time arrays from data files 
    758       REAL(wp) ::   dayfrac, zxy, zoffsett 
    759       REAL(wp) ::   zoffsetu, zoffsetv 
    760       REAL(wp) ::   dayjul0, zdayjulini 
    761       REAL(wp) ::   zinterval_s, zinterval_e                    ! First and last interval in time axis 
    762       REAL(wp), DIMENSION(jpbtime)      ::   zstepr             ! REAL time array from data files 
    763       REAL(wp), DIMENSION(jpbdta,1)     ::   zdta               ! temporary array for data fields 
    764       CHARACTER(LEN=80), DIMENSION(6)   ::   clfile 
    765       CHARACTER(LEN=70 )                ::   clunits            ! units attribute of time coordinate 
    766       !!--------------------------------------------------------------------------- 
    767  
    768 !!gm   add here the same style as in bdy_dta_frs 
    769 !!gm      clearly bdy_dta_fla and bdy_dta_frs  can be combined...    
    770 !!gm      too many things duplicated in the read of data...   simplification can be done 
    771  
    772       ! -------------------- ! 
    773       !    Initialization    ! 
    774       ! -------------------- ! 
    775  
    776       lect   = .false.           ! If true, read a time record 
    777  
    778       ! Some time variables for monthly climatological forcing: 
    779       ! ******************************************************* 
    780  !!gm  here  use directely daymod variables 
    781   
    782       iman  = INT( raamo ) ! Number of months in a year 
    783  
    784       i15 = INT( 2*REAL( nday, wp ) / ( REAL( nmonth_len(nmonth), wp ) + 0.5 ) ) 
    785       ! i15=0 if the current day is in the first half of the month, else i15=1 
    786  
    787       imois = nmonth + i15 - 1            ! imois is the first month record 
    788       IF( imois == 0 ) imois = iman 
    789  
    790       ! Time variable for non-climatological forcing: 
    791       ! ********************************************* 
    792  
    793       itimer = ((kt-1)-nit000+1)*rdt                      ! current time in seconds for interpolation  
    794       itimer = itimer + jit*rdt/REAL(nn_baro,wp)      ! in non-climatological case 
    795  
    796       IF ( ln_tides ) THEN 
    797  
    798          ! -------------------------------------! 
    799          ! Update BDY fields with tidal forcing ! 
    800          ! -------------------------------------!   
    801  
    802          CALL tide_update( kt, jit )  
    803    
    804       ENDIF 
    805  
    806       IF ( ln_dyn_fla ) THEN 
    807  
    808          ! -------------------------------------! 
    809          ! Update BDY fields with model data    ! 
    810          ! -------------------------------------!   
    811  
    812       !                                                !-------------------! 
    813       IF( kt == nit000 .and. jit ==2 ) THEN            !  First call only  ! 
    814          !                                             !-------------------! 
    815          istep_bt(:) = 0 
    816          nbdy_b_bt    = 0 
    817          nbdy_a_bt    = 0 
    818  
    819          ! Get time information from bdy data file 
    820          ! *************************************** 
    821  
    822         IF(lwp) WRITE(numout,*) 
    823         IF(lwp) WRITE(numout,*)    'bdy_dta_fla :Initialize unstructured boundary data for barotropic variables.' 
    824         IF(lwp) WRITE(numout,*)    '~~~~~~~'  
    825  
    826         IF( nn_dtactl == 0 ) THEN 
    827           IF(lwp) WRITE(numout,*)  'Bdy data are taken from initial conditions' 
    828  
    829         ELSEIF (nn_dtactl == 1) THEN 
    830           IF(lwp) WRITE(numout,*)  'Bdy data are read in netcdf files' 
    831  
    832           dayfrac = adatrj  - REAL(itimer,wp)/86400. ! day fraction at time step kt-1 
    833           dayfrac = dayfrac - INT (dayfrac)          ! 
    834           totime = (nitend-nit000+1)*rdt             ! Total time of the run to verify that all the 
    835                                                      ! necessary time dumps in file are included 
    836  
    837           clfile(4) = cn_dta_fla_T 
    838           clfile(5) = cn_dta_fla_U 
    839           clfile(6) = cn_dta_fla_V 
    840  
    841           DO igrd = 4,6 
    842  
    843             CALL iom_open( clfile(igrd), inum ) 
    844             CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy_bt, cdunits=clunits )  
    845  
    846             SELECT CASE( igrd ) 
    847                CASE (4)  
    848                   numbdyt_bt = inum 
    849                CASE (5)  
    850                   numbdyu_bt = inum 
    851                CASE (6)  
    852                   numbdyv_bt = inum 
    853             END SELECT 
    854  
    855             ! Calculate time offset  
    856             READ(clunits,7000) iyear0, imonth0, iday0, ihours0, iminutes0, isec0 
    857             ! Convert time origin in file to julian days  
    858             isec0 = isec0 + ihours0*60.*60. + iminutes0*60. 
    859             CALL ymds2ju(iyear0, imonth0, iday0, REAL(isec0, wp), dayjul0) 
    860             ! Compute model initialization time  
    861             iyear  = ndastp / 10000 
    862             imonth = ( ndastp - iyear * 10000 ) / 100 
    863             iday   = ndastp - iyear * 10000 - imonth * 100 
    864             isecs  = dayfrac * 86400 
    865             CALL ymds2ju(iyear, imonth, iday, REAL(isecs, wp) , zdayjulini) 
    866             ! zoffset from initialization date: 
    867             zoffset = (dayjul0-zdayjulini)*86400 
    868             ! 
    869  
    870 7000 FORMAT('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2) 
    871  
    872             !! TO BE DONE... Check consistency between calendar from file  
    873             !! (available optionally from iom_gettime) and calendar in model  
    874             !! when calendar in model available outside of IOIPSL. 
    875  
    876             ! Check that there are not too many times in the file.  
    877             IF (ntimes_bdy_bt > jpbtime) CALL ctl_stop( & 
    878                  'Number of time dumps in bdy file exceed jpbtime parameter', & 
    879                  'Check file:' // TRIM(clfile(igrd))  ) 
    880  
    881             ! Check that time array increases (or interp will fail): 
    882             DO it = 2, ntimes_bdy_bt 
    883                IF ( zstepr(it-1) >= zstepr(it) ) THEN 
    884                   CALL ctl_stop('Time array in unstructured boundary data file', & 
    885                        'does not continuously increase.',               & 
    886                        'Check file:' // TRIM(clfile(igrd))  ) 
    887                   EXIT 
    888                END IF 
    889             END DO 
    890  
    891             IF ( .NOT. ln_clim ) THEN 
    892                ! Check that times in file span model run time: 
    893  
    894                ! Note: the fields may be time means, so we allow nit000 to be before 
    895                ! first time in the file, provided that it falls inside the meaning 
    896                ! period of the first field.  Until we can get the meaning period 
    897                ! from the file, use the interval between fields as a proxy. 
    898                ! If nit000 is before the first time, use the value at first time 
    899                ! instead of extrapolating.  This is done by putting time 1 into 
    900                ! both time levels. 
    901                ! The same applies to the last time level: see setting of lect below. 
    902  
    903                IF ( ntimes_bdy_bt == 1 ) CALL ctl_stop( & 
    904                     'There is only one time dump in data files', & 
    905                     'Set ln_clim=.true. in namelist for constant bdy forcing.' ) 
    906  
    907                zinterval_s = zstepr(2) - zstepr(1) 
    908                zinterval_e = zstepr(ntimes_bdy_bt) - zstepr(ntimes_bdy_bt-1) 
    909  
    910                IF( zstepr(1) + zoffset > 0 ) THEN 
    911                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 
    912                      CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 ) 
    913                END IF 
    914                IF( zstepr(ntimes_bdy_bt) + zoffset < totime ) THEN 
    915                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 
    916                      CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 ) 
    917                END IF 
    918             END IF ! .NOT. ln_clim 
    919  
    920             IF ( igrd .EQ. 4) THEN 
    921               ntimes_bdyt = ntimes_bdy_bt 
    922               zoffsett = zoffset 
    923               istept(:) = INT( zstepr(:) + zoffset ) 
    924             ELSE IF (igrd .EQ. 5) THEN 
    925               ntimes_bdyu = ntimes_bdy_bt 
    926               zoffsetu = zoffset 
    927               istepu(:) = INT( zstepr(:) + zoffset ) 
    928             ELSE IF (igrd .EQ. 6) THEN 
    929               ntimes_bdyv = ntimes_bdy_bt 
    930               zoffsetv = zoffset 
    931               istepv(:) = INT( zstepr(:) + zoffset ) 
    932             ENDIF 
    933  
    934           ENDDO 
    935  
    936       ! Verify time consistency between files   
    937  
    938           IF ( ntimes_bdyu /= ntimes_bdyt .OR. ntimes_bdyv /= ntimes_bdyt ) THEN 
    939              CALL ctl_stop( & 
    940              'Time axis lengths differ between bdy data files', & 
    941              'Multiple time frequencies not implemented yet' ) 
    942           ELSE 
    943             ntimes_bdy_bt = ntimes_bdyt 
    944           ENDIF 
    945  
    946           IF (zoffsetu.NE.zoffsett .OR. zoffsetv.NE.zoffsett) THEN 
    947             CALL ctl_stop( &  
    948             'Bdy data files must have the same time origin', & 
    949             'Multiple time frequencies not implemented yet'  ) 
    950           ENDIF 
    951           zoffset = zoffsett 
    952  
    953       !! Check that times are the same in the three files... HERE. 
    954           istep_bt(:) = istept(:) 
    955  
    956       ! Check number of time dumps:               
    957           IF (ln_clim) THEN 
    958             SELECT CASE ( ntimes_bdy_bt ) 
    959             CASE( 1 ) 
    960               IF(lwp) WRITE(numout,*) 
    961               IF(lwp) WRITE(numout,*) 'We assume constant boundary forcing from bdy data files' 
    962               IF(lwp) WRITE(numout,*)              
    963             CASE( 12 ) 
    964               IF(lwp) WRITE(numout,*) 
    965               IF(lwp) WRITE(numout,*) 'We assume monthly (and cyclic) boundary forcing from bdy data files' 
    966               IF(lwp) WRITE(numout,*)  
    967             CASE DEFAULT 
    968               CALL ctl_stop( & 
    969                 'For climatological boundary forcing (ln_clim=.true.),',& 
    970                 'bdy data files must contain 1 or 12 time dumps.' ) 
    971             END SELECT 
    972           ENDIF 
    973  
    974       ! Find index of first record to read (before first model time).  
    975  
    976           it=1 
    977           DO WHILE ( ((istep_bt(it+1)) <= 0 ).AND.(it.LE.(ntimes_bdy_bt-1))) 
    978             it=it+1 
    979           END DO 
    980           nbdy_b_bt = it 
    981  
    982           IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 
    983           IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b_bt 
    984  
    985         ENDIF ! endif (nn_dtactl == 1) 
    986  
    987       ! 1.2  Read first record in file if necessary (ie if nn_dtactl == 1) 
    988       ! ***************************************************************** 
    989  
    990         IF ( nn_dtactl == 0) THEN 
    991           ! boundary data arrays are filled with initial conditions 
    992           igrd = 5            ! U-points data  
    993           DO ib = 1, nblen(igrd)               
    994             ubtbdy(ib) = un(nbi(ib,igrd), nbj(ib,igrd), 1) 
    995           END DO 
    996  
    997           igrd = 6            ! V-points data  
    998           DO ib = 1, nblen(igrd)               
    999             vbtbdy(ib) = vn(nbi(ib,igrd), nbj(ib,igrd), 1) 
    1000           END DO 
    1001  
    1002           igrd = 4            ! T-points data  
    1003           DO ib = 1, nblen(igrd)               
    1004             sshbdy(ib) = sshn(nbi(ib,igrd), nbj(ib,igrd)) 
    1005           END DO 
    1006  
    1007         ELSEIF (nn_dtactl == 1) THEN 
    1008   
    1009         ! Set first record in the climatological case:    
    1010           IF ((ln_clim).AND.(ntimes_bdy_bt==1)) THEN 
    1011             nbdy_a_bt = 1 
    1012           ELSEIF ((ln_clim).AND.(ntimes_bdy_bt==iman)) THEN 
    1013             nbdy_b_bt = 0 
    1014             nbdy_a_bt = imois 
    1015           ELSE 
    1016             nbdy_a_bt = nbdy_b_bt 
    1017           END IF 
    1018   
    1019          ! Open Netcdf files: 
    1020  
    1021           CALL iom_open ( cn_dta_fla_T, numbdyt_bt ) 
    1022           CALL iom_open ( cn_dta_fla_U, numbdyu_bt ) 
    1023           CALL iom_open ( cn_dta_fla_V, numbdyv_bt ) 
    1024  
    1025          ! Read first record: 
    1026           ipj=1 
    1027           igrd=4 
    1028           ipi=nblendta(igrd) 
    1029  
    1030           ! ssh 
    1031           igrd=4 
    1032           IF ( nblendta(igrd) .le. 0 ) THEN  
    1033             idvar = iom_varid( numbdyt_bt,'sossheig' ) 
    1034             nblendta(igrd) = iom_file(numbdyt_bt)%dimsz(1,idvar) 
    1035           ENDIF 
    1036           WRITE(numout,*) 'Dim size for sossheig is ',nblendta(igrd) 
    1037           ipi=nblendta(igrd) 
    1038  
    1039           CALL iom_get ( numbdyt_bt, jpdom_unknown,'sossheig',zdta(1:ipi,1:ipj),nbdy_a_bt ) 
    1040  
    1041           DO ib=1, nblen(igrd) 
    1042             sshbdydta(ib,2) =  zdta(nbmap(ib,igrd),1) 
    1043           END DO 
    1044   
    1045           ! u-velocity 
    1046           igrd=5 
    1047           IF ( nblendta(igrd) .le. 0 ) THEN  
    1048             idvar = iom_varid( numbdyu_bt,'vobtcrtx' ) 
    1049             nblendta(igrd) = iom_file(numbdyu_bt)%dimsz(1,idvar) 
    1050           ENDIF 
    1051           WRITE(numout,*) 'Dim size for vobtcrtx is ',nblendta(igrd) 
    1052           ipi=nblendta(igrd) 
    1053  
    1054           CALL iom_get ( numbdyu_bt, jpdom_unknown,'vobtcrtx',zdta(1:ipi,1:ipj),nbdy_a_bt ) 
    1055  
    1056           DO ib=1, nblen(igrd) 
    1057             ubtbdydta(ib,2) =  zdta(nbmap(ib,igrd),1) 
    1058           END DO 
    1059  
    1060           ! v-velocity 
    1061           igrd=6 
    1062           IF ( nblendta(igrd) .le. 0 ) THEN  
    1063             idvar = iom_varid( numbdyv_bt,'vobtcrty' ) 
    1064             nblendta(igrd) = iom_file(numbdyv_bt)%dimsz(1,idvar) 
    1065           ENDIF 
    1066           WRITE(numout,*) 'Dim size for vobtcrty is ',nblendta(igrd) 
    1067           ipi=nblendta(igrd) 
    1068  
    1069           CALL iom_get ( numbdyv_bt, jpdom_unknown,'vobtcrty',zdta(1:ipi,1:ipj),nbdy_a_bt ) 
    1070  
    1071           DO ib=1, nblen(igrd) 
    1072             vbtbdydta(ib,2) =  zdta(nbmap(ib,igrd),1) 
    1073           END DO 
    1074  
    1075         END IF 
    1076   
    1077         ! In the case of constant boundary forcing fill bdy arrays once for all 
    1078         IF ((ln_clim).AND.(ntimes_bdy_bt==1)) THEN 
    1079  
    1080           ubtbdy  (:) = ubtbdydta  (:,2) 
    1081           vbtbdy  (:) = vbtbdydta  (:,2) 
    1082           sshbdy  (:) = sshbdydta  (:,2) 
    1083  
    1084           CALL iom_close( numbdyt_bt ) 
    1085           CALL iom_close( numbdyu_bt ) 
    1086           CALL iom_close( numbdyv_bt ) 
    1087  
    1088         END IF 
    1089  
    1090       ENDIF ! End if nit000 
    1091  
    1092       ! -------------------- ! 
    1093       ! 2. At each time step ! 
    1094       ! -------------------- ! 
    1095  
    1096       IF ((nn_dtactl==1).AND.(ntimes_bdy_bt>1)) THEN  
    1097  
    1098       ! 2.1 Read one more record if necessary 
    1099       !************************************** 
    1100  
    1101         IF ( (ln_clim).AND.(imois/=nbdy_b_bt) ) THEN ! remember that nbdy_b_bt=0 for kt=nit000 
    1102          nbdy_b_bt = imois 
    1103          nbdy_a_bt = imois+1 
    1104          nbdy_b_bt = MOD( nbdy_b_bt, iman ) 
    1105          IF( nbdy_b_bt == 0 ) nbdy_b_bt = iman 
    1106          nbdy_a_bt = MOD( nbdy_a_bt, iman ) 
    1107          IF( nbdy_a_bt == 0 ) nbdy_a_bt = iman 
    1108          lect=.true. 
    1109  
    1110         ELSEIF ((.NOT.ln_clim).AND.(itimer >= istep_bt(nbdy_a_bt))) THEN 
    1111           nbdy_b_bt=nbdy_a_bt 
    1112           nbdy_a_bt=nbdy_a_bt+1 
    1113           lect=.true. 
    1114         END IF 
    1115           
    1116         IF (lect) THEN 
    1117  
    1118         ! Swap arrays 
    1119           sshbdydta(:,1) =  sshbdydta(:,2) 
    1120           ubtbdydta(:,1) =  ubtbdydta(:,2) 
    1121           vbtbdydta(:,1) =  vbtbdydta(:,2) 
    1122   
    1123         ! read another set 
    1124  
    1125           ipj=1 
    1126           ipk=jpk 
    1127           igrd=4 
    1128           ipi=nblendta(igrd) 
    1129  
    1130            
    1131           ! ssh 
    1132           igrd=4 
    1133           ipi=nblendta(igrd) 
    1134  
    1135           CALL iom_get ( numbdyt_bt, jpdom_unknown,'sossheig',zdta(1:ipi,1:ipj),nbdy_a_bt ) 
    1136  
    1137           DO ib=1, nblen(igrd) 
    1138             sshbdydta(ib,2) =  zdta(nbmap(ib,igrd),1) 
    1139           END DO 
    1140  
    1141           ! u-velocity 
    1142           igrd=5 
    1143           ipi=nblendta(igrd) 
    1144  
    1145           CALL iom_get ( numbdyu_bt, jpdom_unknown,'vobtcrtx',zdta(1:ipi,1:ipj),nbdy_a_bt ) 
    1146  
    1147           DO ib=1, nblen(igrd) 
    1148             ubtbdydta(ib,2) =  zdta(nbmap(ib,igrd),1) 
    1149           END DO 
    1150  
    1151           ! v-velocity 
    1152           igrd=6 
    1153           ipi=nblendta(igrd) 
    1154  
    1155           CALL iom_get ( numbdyv_bt, jpdom_unknown,'vobtcrty',zdta(1:ipi,1:ipj),nbdy_a_bt ) 
    1156  
    1157           DO ib=1, nblen(igrd) 
    1158             vbtbdydta(ib,2) =  zdta(nbmap(ib,igrd),1) 
    1159           END DO 
    1160  
    1161  
    1162          IF(lwp) WRITE(numout,*) 'bdy_dta_fla : first record file used nbdy_b_bt ',nbdy_b_bt 
    1163          IF(lwp) WRITE(numout,*) '~~~~~~~~  last  record file used nbdy_a_bt ',nbdy_a_bt 
    1164          IF (.NOT.ln_clim) THEN 
    1165            IF(lwp) WRITE(numout,*) 'first  record time (s): ', istep_bt(nbdy_b_bt) 
    1166            IF(lwp) WRITE(numout,*) 'model time (s)        : ', itimer 
    1167            IF(lwp) WRITE(numout,*) 'second record time (s): ', istep_bt(nbdy_a_bt) 
    1168          ENDIF 
    1169         END IF ! end lect=.true. 
    1170  
    1171  
    1172       ! 2.2   Interpolate linearly: 
    1173       ! *************************** 
    1174      
    1175         IF (ln_clim) THEN 
    1176           zxy = REAL( nday, wp ) / REAL( nmonth_len(nbdy_b_bt), wp ) + 0.5 - i15 
    1177         ELSE           
    1178           zxy = REAL(istep_bt(nbdy_b_bt)-itimer, wp) / REAL(istep_bt(nbdy_b_bt)-istep_bt(nbdy_a_bt), wp) 
    1179         END IF 
    1180  
    1181           igrd=4 
    1182           DO ib=1, nblen(igrd) 
    1183             sshbdy(ib) = zxy      * sshbdydta(ib,2) + & 
    1184                        (1.-zxy) * sshbdydta(ib,1)    
    1185           END DO 
    1186  
    1187           igrd=5 
    1188           DO ib=1, nblen(igrd) 
    1189             ubtbdy(ib) = zxy      * ubtbdydta(ib,2) + & 
    1190                          (1.-zxy) * ubtbdydta(ib,1)    
    1191           END DO 
    1192  
    1193           igrd=6 
    1194           DO ib=1, nblen(igrd) 
    1195             vbtbdy(ib) = zxy      * vbtbdydta(ib,2) + & 
    1196                          (1.-zxy) * vbtbdydta(ib,1)    
    1197           END DO 
    1198  
    1199  
    1200       END IF !end if ((nn_dtactl==1).AND.(ntimes_bdy_bt>1)) 
    1201      
    1202       ! ------------------- ! 
    1203       ! Last call kt=nitend ! 
    1204       ! ------------------- ! 
    1205  
    1206       ! Closing of the 3 files 
    1207       IF( kt == nitend   .and. jit == icycl ) THEN 
    1208           CALL iom_close( numbdyt_bt ) 
    1209           CALL iom_close( numbdyu_bt ) 
    1210           CALL iom_close( numbdyv_bt ) 
    1211       ENDIF 
    1212  
    1213       ENDIF ! ln_dyn_frs 
    1214  
    1215       END SUBROUTINE bdy_dta_fla 
    1216  
     603               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 
     604                  jfld = jfld + 1 
     605                  dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
     606               ENDIF 
     607               jfld = jfld + 1 
     608               dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 
     609               jfld = jfld + 1 
     610               dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 
     611            ENDIF 
     612         ENDIF 
     613 
     614         IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
     615            IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 
     616               ilen0(1:3) = nblen(1:3) 
     617            ELSE 
     618               ilen0(1:3) = nblenrim(1:3) 
     619            ENDIF 
     620            ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 
     621            ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 
     622         ENDIF 
     623         IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 
     624           &  ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.   & 
     625           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     626            jfld = jfld + 1 
     627            dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
     628            jfld = jfld + 1 
     629            dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
     630         ENDIF 
     631 
     632         IF (nn_tra(ib_bdy) .gt. 0) THEN 
     633            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
     634               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 
     635                  ilen0(1:3) = nblen(1:3) 
     636               ELSE 
     637                  ilen0(1:3) = nblenrim(1:3) 
     638               ENDIF 
     639               ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 
     640               ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 
     641            ELSE 
     642               jfld = jfld + 1 
     643               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 
     644               jfld = jfld + 1 
     645               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) 
     646            ENDIF 
     647         ENDIF 
     648 
     649#if defined key_lim2 
     650         IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 
     651            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 
     652               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     653                  ilen0(1:3) = nblen(1:3) 
     654               ELSE 
     655                  ilen0(1:3) = nblenrim(1:3) 
     656               ENDIF 
     657               ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 
     658               ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 
     659               ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 
     660            ELSE 
     661               jfld = jfld + 1 
     662               dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1) 
     663               jfld = jfld + 1 
     664               dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1) 
     665               jfld = jfld + 1 
     666               dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1) 
     667            ENDIF 
     668         ENDIF 
     669#endif 
     670 
     671      ENDDO ! ib_bdy  
     672 
     673      END SUBROUTINE bdy_dta_init 
    1217674 
    1218675#else 
    1219676   !!---------------------------------------------------------------------- 
    1220    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
     677   !!   Dummy module                   NO Open Boundary Conditions 
    1221678   !!---------------------------------------------------------------------- 
    1222679CONTAINS 
    1223    SUBROUTINE bdy_dta_frs( kt )              ! Empty routine 
    1224       WRITE(*,*) 'bdy_dta_frs: You should not have seen this print! error?', kt 
    1225    END SUBROUTINE bdy_dta_frs 
    1226    SUBROUTINE bdy_dta_fla( kt, kit, icycle )      ! Empty routine 
    1227       WRITE(*,*) 'bdy_dta_frs: You should not have seen this print! error?', kt, kit 
    1228    END SUBROUTINE bdy_dta_fla 
     680   SUBROUTINE bdy_dta( kt, jit, time_offset ) ! Empty routine 
     681      INTEGER, INTENT( in )           ::   kt     
     682      INTEGER, INTENT( in ), OPTIONAL ::   jit    
     683      INTEGER, INTENT( in ), OPTIONAL ::   time_offset 
     684      WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt 
     685   END SUBROUTINE bdy_dta 
     686   SUBROUTINE bdy_dta_init()                  ! Empty routine 
     687      WRITE(*,*) 'bdy_dta_init: You should not have seen this print! error?' 
     688   END SUBROUTINE bdy_dta_init 
    1229689#endif 
    1230690 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r2528 r3116  
    1515   !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    1616   !!---------------------------------------------------------------------- 
    17    !!   bdy_dyn_frs    : relaxation of velocities on unstructured open boundary 
    18    !!   bdy_dyn_fla    : Flather condition for barotropic solution 
     17   !!   bdy_dyn3d        : apply open boundary conditions to baroclinic velocities 
     18   !!   bdy_dyn3d_frs    : apply Flow Relaxation Scheme 
    1919   !!---------------------------------------------------------------------- 
    2020   USE oce             ! ocean dynamics and tracers  
    2121   USE dom_oce         ! ocean space and time domain 
     22   USE dynspg_oce       
    2223   USE bdy_oce         ! ocean open boundary conditions 
    23    USE dynspg_oce      ! for barotropic variables 
    24    USE phycst          ! physical constants 
     24   USE bdydyn2d        ! open boundary conditions for barotropic solution 
     25   USE bdydyn3d        ! open boundary conditions for baroclinic velocities 
    2526   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    26    USE bdytides        ! for tidal harmonic forcing at boundary 
    2727   USE in_out_manager  ! 
    2828 
    … …  
    3030   PRIVATE 
    3131 
    32    PUBLIC   bdy_dyn_frs   ! routine called in dynspg_flt (free surface case ONLY) 
    33 # if defined key_dynspg_exp || defined key_dynspg_ts 
    34    PUBLIC   bdy_dyn_fla   ! routine called in dynspg_flt (free surface case ONLY) 
    35 # endif 
     32   PUBLIC   bdy_dyn     ! routine called in dynspg_flt (if lk_dynspg_flt) or  
     33                        ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 
    3634 
     35#  include "domzgr_substitute.h90" 
    3736   !!---------------------------------------------------------------------- 
    3837   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    4241CONTAINS 
    4342 
    44    SUBROUTINE bdy_dyn_frs( kt ) 
     43   SUBROUTINE bdy_dyn( kt, dyn3d_only ) 
    4544      !!---------------------------------------------------------------------- 
    46       !!                  ***  SUBROUTINE bdy_dyn_frs  *** 
     45      !!                  ***  SUBROUTINE bdy_dyn  *** 
    4746      !! 
    48       !! ** Purpose : - Apply the Flow Relaxation Scheme for dynamic in the   
    49       !!                case of unstructured open boundaries. 
     47      !! ** Purpose : - Wrapper routine for bdy_dyn2d and bdy_dyn3d. 
    5048      !! 
    51       !! References :- Engedahl H., 1995: Use of the flow relaxation scheme in  
    52       !!               a three-dimensional baroclinic ocean model with realistic 
    53       !!               topography. Tellus, 365-382. 
    5449      !!---------------------------------------------------------------------- 
    55       INTEGER, INTENT( in ) ::   kt   ! Main time step counter 
     50      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     51      USE wrk_nemo, ONLY: wrk_2d_7, wrk_2d_8      ! 2D workspace 
    5652      !! 
    57       INTEGER  ::   jb, jk         ! dummy loop indices 
    58       INTEGER  ::   ii, ij, igrd   ! local integers 
    59       REAL(wp) ::   zwgt           ! boundary weight 
    60       !!---------------------------------------------------------------------- 
    61       ! 
    62       IF(ln_dyn_frs) THEN       ! If this is false, then this routine does nothing.  
    63          ! 
    64          IF( kt == nit000 ) THEN 
    65             IF(lwp) WRITE(numout,*) 
    66             IF(lwp) WRITE(numout,*) 'bdy_dyn_frs : Flow Relaxation Scheme on momentum' 
    67             IF(lwp) WRITE(numout,*) '~~~~~~~' 
    68          ENDIF 
    69          ! 
    70          igrd = 2                      ! Relaxation of zonal velocity 
    71          DO jb = 1, nblen(igrd) 
    72             DO jk = 1, jpkm1 
    73                ii   = nbi(jb,igrd) 
    74                ij   = nbj(jb,igrd) 
    75                zwgt = nbw(jb,igrd) 
    76                ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk) 
    77             END DO 
    78          END DO 
    79          ! 
    80          igrd = 3                      ! Relaxation of meridional velocity 
    81          DO jb = 1, nblen(igrd) 
    82             DO jk = 1, jpkm1 
    83                ii   = nbi(jb,igrd) 
    84                ij   = nbj(jb,igrd) 
    85                zwgt = nbw(jb,igrd) 
    86                va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk) 
    87             END DO 
    88          END DO  
    89          CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 
    90          ! 
    91       ENDIF ! ln_dyn_frs 
    92       ! 
    93    END SUBROUTINE bdy_dyn_frs 
     53      INTEGER, INTENT( in )           :: kt               ! Main time step counter 
     54      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
     55      !! 
     56      INTEGER               :: jk,ii,ij,ib,igrd     ! Loop counter 
     57      LOGICAL               :: ll_dyn2d, ll_dyn3d   
     58      !! 
    9459 
     60      IF(wrk_in_use(2, 7,8) ) THEN 
     61         CALL ctl_stop('bdy_dyn: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
     62      END IF 
    9563 
    96 # if defined   key_dynspg_exp   ||   defined key_dynspg_ts 
    97    !!---------------------------------------------------------------------- 
    98    !!   'key_dynspg_exp'        OR              explicit sea surface height 
    99    !!   'key_dynspg_ts '                  split-explicit sea surface height 
    100    !!---------------------------------------------------------------------- 
    101     
    102 !! Option to use Flather with dynspg_flt not coded yet... 
     64      ll_dyn2d = .true. 
     65      ll_dyn3d = .true. 
    10366 
    104    SUBROUTINE bdy_dyn_fla( pssh ) 
    105       !!---------------------------------------------------------------------- 
    106       !!                 ***  SUBROUTINE bdy_dyn_fla  *** 
    107       !!              
    108       !!              - Apply Flather boundary conditions on normal barotropic velocities  
    109       !!                (ln_dyn_fla=.true. or ln_tides=.true.) 
    110       !! 
    111       !! ** WARNINGS about FLATHER implementation: 
    112       !!1. According to Palma and Matano, 1998 "after ssh" is used.  
    113       !!   In ROMS and POM implementations, it is "now ssh". In the current  
    114       !!   implementation (tested only in the EEL-R5 conf.), both cases were unstable.  
    115       !!   So I use "before ssh" in the following. 
    116       !! 
    117       !!2. We assume that the normal ssh gradient at the bdy is zero. As a matter of  
    118       !!   fact, the model ssh just inside the dynamical boundary is used (the outside   
    119       !!   ssh in the code is not updated). 
    120       !! 
    121       !! References:  Flather, R. A., 1976: A tidal model of the northwest European 
    122       !!              continental shelf. Mem. Soc. R. Sci. Liege, Ser. 6,10, 141-164.      
    123       !!---------------------------------------------------------------------- 
    124       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh 
     67      IF( PRESENT(dyn3d_only) ) THEN 
     68         IF( dyn3d_only ) ll_dyn2d = .false. 
     69      ENDIF 
    12570 
    126       INTEGER  ::   jb, igrd                         ! dummy loop indices 
    127       INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses 
    128       REAL(wp) ::   zcorr                            ! Flather correction 
    129       REAL(wp) ::   zforc                            ! temporary scalar 
    130       !!---------------------------------------------------------------------- 
     71      !------------------------------------------------------- 
     72      ! Set pointers 
     73      !------------------------------------------------------- 
    13174 
    132       ! ---------------------------------! 
    133       ! Flather boundary conditions     :! 
    134       ! ---------------------------------!  
    135       
    136       IF(ln_dyn_fla .OR. ln_tides) THEN ! If these are both false, then this routine does nothing.  
     75      pssh => sshn 
     76      phur => hur 
     77      phvr => hvr 
     78      pu2d => wrk_2d_7 
     79      pv2d => wrk_2d_8 
    13780 
    138          ! Fill temporary array with ssh data (here spgu): 
    139          igrd = 4 
    140          spgu(:,:) = 0.0 
    141          DO jb = 1, nblenrim(igrd) 
    142             ii = nbi(jb,igrd) 
    143             ij = nbj(jb,igrd) 
    144             IF( ln_dyn_fla ) spgu(ii, ij) = sshbdy(jb) 
    145             IF( ln_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(jb) 
    146          END DO 
    147          ! 
    148          igrd = 5      ! Flather bc on u-velocity;  
    149          !             ! remember that flagu=-1 if normal velocity direction is outward 
    150          !             ! I think we should rather use after ssh ? 
    151          DO jb = 1, nblenrim(igrd) 
    152             ii  = nbi(jb,igrd) 
    153             ij  = nbj(jb,igrd)  
    154             iim1 = ii + MAX( 0, INT( flagu(jb) ) )   ! T pts i-indice inside the boundary 
    155             iip1 = ii - MIN( 0, INT( flagu(jb) ) )   ! T pts i-indice outside the boundary  
    156             ! 
    157             zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
    158             zforc = ubtbdy(jb) + utide(jb) 
    159             ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1)  
    160          END DO 
    161          ! 
    162          igrd = 6      ! Flather bc on v-velocity 
    163          !             ! remember that flagv=-1 if normal velocity direction is outward 
    164          DO jb = 1, nblenrim(igrd) 
    165             ii  = nbi(jb,igrd) 
    166             ij  = nbj(jb,igrd)  
    167             ijm1 = ij + MAX( 0, INT( flagv(jb) ) )   ! T pts j-indice inside the boundary 
    168             ijp1 = ij - MIN( 0, INT( flagv(jb) ) )   ! T pts j-indice outside the boundary  
    169             ! 
    170             zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
    171             zforc = vbtbdy(jb) + vtide(jb) 
    172             va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 
    173          END DO 
    174          CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated 
    175          CALL lbc_lnk( va_e, 'V', -1. )   ! 
    176          ! 
    177       ENDIF ! ln_dyn_fla .or. ln_tides 
    178       ! 
    179    END SUBROUTINE bdy_dyn_fla 
    180 #endif 
     81      !------------------------------------------------------- 
     82      ! Split velocities into barotropic and baroclinic parts 
     83      !------------------------------------------------------- 
     84 
     85      pu2d(:,:) = 0.e0 
     86      pv2d(:,:) = 0.e0 
     87      DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
     88          pu2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
     89          pv2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     90      END DO 
     91      pu2d(:,:) = pu2d(:,:) * phur(:,:) 
     92      pv2d(:,:) = pv2d(:,:) * phvr(:,:) 
     93      DO jk = 1 , jpkm1 
     94         ua(:,:,jk) = ua(:,:,jk) - pu2d(:,:) 
     95         va(:,:,jk) = va(:,:,jk) - pv2d(:,:) 
     96      END DO 
     97 
     98      !------------------------------------------------------- 
     99      ! Apply boundary conditions to barotropic and baroclinic 
     100      ! parts separately 
     101      !------------------------------------------------------- 
     102 
     103      IF( ll_dyn2d ) CALL bdy_dyn2d( kt ) 
     104 
     105      IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) 
     106 
     107      !------------------------------------------------------- 
     108      ! Recombine velocities 
     109      !------------------------------------------------------- 
     110 
     111      DO jk = 1 , jpkm1 
     112         ua(:,:,jk) = ( ua(:,:,jk) + pu2d(:,:) ) * umask(:,:,jk) 
     113         va(:,:,jk) = ( va(:,:,jk) + pv2d(:,:) ) * vmask(:,:,jk) 
     114      END DO 
     115 
     116      IF(wrk_not_released(2, 7,8) )    CALL ctl_stop('bdy_dyn: ERROR: failed to release workspace arrays.') 
     117 
     118   END SUBROUTINE bdy_dyn 
    181119 
    182120#else 
    … …  
    185123   !!---------------------------------------------------------------------- 
    186124CONTAINS 
    187    SUBROUTINE bdy_dyn_frs( kt )      ! Empty routine 
    188       WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt 
    189    END SUBROUTINE bdy_dyn_frs 
    190    SUBROUTINE bdy_dyn_fla( pssh )    ! Empty routine 
    191       REAL :: pssh(:,:) 
    192       WRITE(*,*) 'bdy_dyn_fla: You should not have seen this print! error?', pssh(1,1) 
    193    END SUBROUTINE bdy_dyn_fla 
     125   SUBROUTINE bdy_dyn( kt )      ! Empty routine 
     126      WRITE(*,*) 'bdy_dyn: You should not have seen this print! error?', kt 
     127   END SUBROUTINE bdy_dyn 
    194128#endif 
    195129 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r2715 r3116  
    1010   !!            3.3  !  2010-09  (E.O'Dea) updates for Shelf configurations 
    1111   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
     12   !!            3.4  !  2011     (D. Storkey, J. Chanut) OBC-BDY merge 
     13   !!                 !  --- Renamed bdyini.F90 -> bdyini.F90 --- 
    1214   !!---------------------------------------------------------------------- 
    1315#if defined key_bdy 
    … …  
    1921   USE oce             ! ocean dynamics and tracers variables 
    2022   USE dom_oce         ! ocean space and time domain 
    21    USE obc_par         ! ocean open boundary conditions 
    2223   USE bdy_oce         ! unstructured open boundary conditions 
    23    USE bdydta, ONLY: bdy_dta_alloc ! open boundary data 
    24    USE bdytides        ! tides at open boundaries initialization (tide_init routine) 
    2524   USE in_out_manager  ! I/O units 
    2625   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    5251      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    5352      !!----------------------------------------------------------------------       
    54       INTEGER  ::   ii, ij, ik, igrd, ib, ir   ! dummy loop indices 
    55       INTEGER  ::   icount, icountr, ib_len, ibr_max   ! local integers 
    56       INTEGER  ::   iw, ie, is, in, inum, id_dummy     !   -       - 
    57       INTEGER  ::   igrd_start, igrd_end               !   -       - 
    58       REAL(wp) ::   zefl, zwfl, znfl, zsfl              ! local scalars 
    59       INTEGER, DIMENSION (2)             ::   kdimsz 
    60       INTEGER, DIMENSION(jpbdta, jpbgrd) ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta 
    61       INTEGER, DIMENSION(jpbdta, jpbgrd) ::   nbrdta           ! Discrete distance from rim points 
    62       REAL(wp), DIMENSION(jpidta,jpjdta) ::   zmask            ! global domain mask 
    63       REAL(wp), DIMENSION(jpbdta,1)      ::   zdta             ! temporary array  
    64       CHARACTER(LEN=80),DIMENSION(6)     ::   clfile 
     53      ! namelist variables 
     54      !------------------- 
     55      INTEGER, PARAMETER          :: jp_nseg = 100 
     56      INTEGER                     :: nbdysege, nbdysegw, nbdysegn, nbdysegs  
     57      INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft 
     58      INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft 
     59      INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft 
     60      INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft 
     61 
     62      ! local variables 
     63      !------------------- 
     64      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 
     65      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers 
     66      INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       - 
     67      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       - 
     68      INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts 
     69      REAL   , POINTER  ::  flagu, flagv                   !    -   - 
     70      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
     71      INTEGER, DIMENSION (2)                ::   kdimsz 
     72      INTEGER, DIMENSION(jpbgrd,jp_bdy)       ::   nblendta         ! Length of index arrays  
     73      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta 
     74      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points 
     75      REAL(wp), DIMENSION(jpidta,jpjdta)    ::   zmask            ! global domain mask 
     76      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile 
     77      CHARACTER(LEN=1),DIMENSION(jpbgrd)   ::   cgrid 
    6578      !! 
    66       NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V,   & 
    67          &            cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V,            & 
    68          &            ln_tides, ln_clim, ln_vol, ln_mask,                  & 
    69          &            ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs,       & 
    70          &            nn_dtactl, nn_rimwidth, nn_volctl 
     79      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             & 
     80         &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, & 
     81         &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,         &   
     82#if defined key_lim2 
     83         &             nn_ice_lim2, nn_ice_lim2_dta,                       & 
     84#endif 
     85         &             ln_vol, nn_volctl,                                  & 
     86         &             nn_rimwidth, nn_dmp2d_in, nn_dmp2d_out,             & 
     87         &             nn_dmp3d_in, nn_dmp3d_out 
     88      !! 
     89      NAMELIST/nambdy_index/ nbdysege, jpieob, jpjedt, jpjeft,             & 
     90                             nbdysegw, jpiwob, jpjwdt, jpjwft,             & 
     91                             nbdysegn, jpjnob, jpindt, jpinft,             & 
     92                             nbdysegs, jpjsob, jpisdt, jpisft 
     93 
    7194      !!---------------------------------------------------------------------- 
    7295 
     96      IF( bdy_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' ) 
     97 
    7398      IF(lwp) WRITE(numout,*) 
    74       IF(lwp) WRITE(numout,*) 'bdy_init : initialization of unstructured open boundaries' 
     99      IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 
    75100      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    76101      ! 
    77       !                                      ! allocate bdy_oce arrays 
    78       IF( bdy_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' ) 
    79       IF( bdy_dta_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate dta arrays' ) 
    80102 
    81103      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   & 
    82          &                               ' and unstructured open boundary condition are not compatible' ) 
    83  
    84       IF( lk_obc      )   CALL ctl_stop( 'Straight open boundaries,',   & 
    85          &                               ' and unstructured open boundaries are not compatible' ) 
    86  
    87       ! --------------------------- 
    88       REWIND( numnam )                    ! Read namelist parameters 
     104         &                               ' and general open boundary condition are not compatible' ) 
     105 
     106      cgrid= (/'t','u','v'/) 
     107 
     108      ! ----------------------------------------- 
     109      ! Initialise and read namelist parameters 
     110      ! ----------------------------------------- 
     111 
     112      nb_bdy            = 0 
     113      ln_coords_file(:) = .false. 
     114      cn_coords_file(:) = '' 
     115      ln_mask_file      = .false. 
     116      cn_mask_file(:)   = '' 
     117      nn_dyn2d(:)       = 0 
     118      nn_dyn2d_dta(:)   = -1  ! uninitialised flag 
     119      nn_dyn3d(:)       = 0 
     120      nn_dyn3d_dta(:)   = -1  ! uninitialised flag 
     121      nn_tra(:)         = 0 
     122      nn_tra_dta(:)     = -1  ! uninitialised flag 
     123#if defined key_lim2 
     124      nn_ice_lim2(:)    = 0 
     125      nn_ice_lim2_dta(:)= -1  ! uninitialised flag 
     126#endif 
     127      ln_vol            = .false. 
     128      nn_volctl         = -1  ! uninitialised flag 
     129      nn_rimwidth(:)    = -1  ! uninitialised flag 
     130      nn_dmp2d_in(:)    = -1  ! uninitialised flag 
     131      nn_dmp2d_out(:)   = -1  ! uninitialised flag 
     132      nn_dmp3d_in(:)    = -1  ! uninitialised flag 
     133      nn_dmp3d_out(:)   = -1  ! uninitialised flag 
     134 
     135      REWIND( numnam )                     
    89136      READ  ( numnam, nambdy ) 
     137 
     138      ! ----------------------------------------- 
     139      ! Check and write out namelist parameters 
     140      ! ----------------------------------------- 
    90141 
    91142      !                                   ! control prints 
    92143      IF(lwp) WRITE(numout,*) '         nambdy' 
    93144 
    94       !                                         ! check type of data used (nn_dtactl value) 
    95       IF(lwp) WRITE(numout,*) 'nn_dtactl =', nn_dtactl       
    96       IF(lwp) WRITE(numout,*) 
    97       SELECT CASE( nn_dtactl )                   !  
    98       CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    99       CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    100       CASE DEFAULT   ;   CALL ctl_stop( 'nn_dtactl must be 0 or 1' ) 
    101       END SELECT 
    102  
    103       IF(lwp) WRITE(numout,*) 
    104       IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nn_rimwidth = ', nn_rimwidth 
    105  
    106       IF(lwp) WRITE(numout,*) 
    107       IF(lwp) WRITE(numout,*) '      nn_volctl = ', nn_volctl 
    108  
    109       IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value) 
    110          SELECT CASE ( nn_volctl ) 
     145      IF( nb_bdy .eq. 0 ) THEN  
     146        IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 
     147      ELSE 
     148        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ',nb_bdy 
     149      ENDIF 
     150 
     151      DO ib_bdy = 1,nb_bdy 
     152        IF(lwp) WRITE(numout,*) ' '  
     153        IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------'  
     154 
     155        IF( ln_coords_file(ib_bdy) ) THEN 
     156           IF(lwp) WRITE(numout,*) 'Boundary definition read from file '//TRIM(cn_coords_file(ib_bdy)) 
     157        ELSE 
     158           IF(lwp) WRITE(numout,*) 'Boundary defined in namelist.' 
     159        ENDIF 
     160        IF(lwp) WRITE(numout,*) 
     161 
     162        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
     163        SELECT CASE( nn_dyn2d(ib_bdy) )                   
     164          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     165          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     166          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
     167          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 
     168        END SELECT 
     169        IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     170           SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   !  
     171              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     172              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
     173              CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      tidal harmonic forcing taken from file' 
     174              CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      boundary data AND tidal harmonic forcing taken from files' 
     175              CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' ) 
     176           END SELECT 
     177        ENDIF 
     178        IF(lwp) WRITE(numout,*) 
     179 
     180        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
     181        SELECT CASE( nn_dyn3d(ib_bdy) )                   
     182          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     183          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     184          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 
     185        END SELECT 
     186        IF( nn_dyn3d(ib_bdy) .gt. 0 ) THEN 
     187           SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   !  
     188              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     189              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
     190              CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn3d_dta must be 0 or 1' ) 
     191           END SELECT 
     192        ENDIF 
     193        IF(lwp) WRITE(numout,*) 
     194 
     195        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
     196        SELECT CASE( nn_tra(ib_bdy) )                   
     197          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     198          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     199          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     200        END SELECT 
     201        IF( nn_tra(ib_bdy) .gt. 0 ) THEN 
     202           SELECT CASE( nn_tra_dta(ib_bdy) )                   !  
     203              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     204              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
     205              CASE DEFAULT   ;   CALL ctl_stop( 'nn_tra_dta must be 0 or 1' ) 
     206           END SELECT 
     207        ENDIF 
     208        IF(lwp) WRITE(numout,*) 
     209 
     210#if defined key_lim2 
     211        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
     212        SELECT CASE( nn_ice_lim2(ib_bdy) )                   
     213          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     214          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     215          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     216        END SELECT 
     217        IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN  
     218           SELECT CASE( nn_ice_lim2_dta(ib_bdy) )                   !  
     219              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     220              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
     221              CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim2_dta must be 0 or 1' ) 
     222           END SELECT 
     223        ENDIF 
     224        IF(lwp) WRITE(numout,*) 
     225#endif 
     226 
     227        IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS scheme = ', nn_rimwidth(ib_bdy) 
     228        IF(lwp) WRITE(numout,*) 
     229 
     230      ENDDO 
     231 
     232     IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value) 
     233       IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' 
     234       IF(lwp) WRITE(numout,*) 
     235       SELECT CASE ( nn_volctl ) 
    111236         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant' 
    112237         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux' 
    113238         CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' ) 
    114          END SELECT 
    115          IF(lwp) WRITE(numout,*) 
    116       ELSE 
    117          IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 
    118          IF(lwp) WRITE(numout,*) 
    119       ENDIF 
    120  
    121       IF( ln_tides ) THEN 
    122         IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 
    123         IF(lwp) WRITE(numout,*) 
    124       ENDIF 
    125  
    126       IF( ln_dyn_fla ) THEN 
    127         IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 
    128         IF(lwp) WRITE(numout,*) 
    129       ENDIF 
    130  
    131       IF( ln_dyn_frs ) THEN 
    132         IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 
    133         IF(lwp) WRITE(numout,*) 
    134       ENDIF 
    135  
    136       IF( ln_tra_frs ) THEN 
    137         IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 
    138         IF(lwp) WRITE(numout,*) 
    139       ENDIF 
    140  
    141       IF( ln_ice_frs ) THEN 
    142         IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 
    143         IF(lwp) WRITE(numout,*) 
    144       ENDIF 
    145  
    146       IF( ln_tides )   CALL tide_init      ! Read tides namelist  
    147  
    148  
    149       ! Read arrays defining unstructured open boundaries 
     239       END SELECT 
     240       IF(lwp) WRITE(numout,*) 
     241     ELSE 
     242       IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 
     243       IF(lwp) WRITE(numout,*) 
     244     ENDIF 
     245 
    150246      ! ------------------------------------------------- 
     247      ! Initialise indices arrays for open boundaries 
     248      ! ------------------------------------------------- 
     249 
     250      ! Work out global dimensions of boundary data 
     251      ! --------------------------------------------- 
     252      REWIND( numnam )                     
     253      DO ib_bdy = 1, nb_bdy 
     254 
     255         jpbdta = 1 
     256         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters 
     257  
     258            ! No REWIND here because may need to read more than one nambdy_index namelist. 
     259            READ  ( numnam, nambdy_index ) 
     260 
     261            ! Automatic boundary definition: if nbdysegX = -1 
     262            ! set boundary to whole side of model domain. 
     263            IF( nbdysege == -1 ) THEN 
     264               nbdysege = 1 
     265               jpieob(1) = jpiglo - 1 
     266               jpjedt(1) = 2 
     267               jpjeft(1) = jpjglo - 1 
     268            ENDIF 
     269            IF( nbdysegw == -1 ) THEN 
     270               nbdysegw = 1 
     271               jpiwob(1) = 2 
     272               jpjwdt(1) = 2 
     273               jpjwft(1) = jpjglo - 1 
     274            ENDIF 
     275            IF( nbdysegn == -1 ) THEN 
     276               nbdysegn = 1 
     277               jpjnob(1) = jpjglo - 1 
     278               jpindt(1) = 2 
     279               jpinft(1) = jpiglo - 1 
     280            ENDIF 
     281            IF( nbdysegs == -1 ) THEN 
     282               nbdysegs = 1 
     283               jpjsob(1) = 2 
     284               jpisdt(1) = 2 
     285               jpisft(1) = jpiglo - 1 
     286            ENDIF 
     287 
     288            nblendta(:,ib_bdy) = 0 
     289            DO iseg = 1, nbdysege 
     290               igrd = 1 
     291               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1                
     292               igrd = 2 
     293               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1                
     294               igrd = 3 
     295               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg)                
     296            ENDDO 
     297            DO iseg = 1, nbdysegw 
     298               igrd = 1 
     299               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1                
     300               igrd = 2 
     301               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1                
     302               igrd = 3 
     303               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg)                
     304            ENDDO 
     305            DO iseg = 1, nbdysegn 
     306               igrd = 1 
     307               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1                
     308               igrd = 2 
     309               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg)                
     310               igrd = 3 
     311               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1 
     312            ENDDO 
     313            DO iseg = 1, nbdysegs 
     314               igrd = 1 
     315               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1                
     316               igrd = 2 
     317               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) 
     318               igrd = 3 
     319               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1                
     320            ENDDO 
     321 
     322            nblendta(:,ib_bdy) = nblendta(:,ib_bdy) * nn_rimwidth(ib_bdy) 
     323            jpbdta = MAXVAL(nblendta(:,ib_bdy))                
     324 
     325 
     326         ELSE            ! Read size of arrays in boundary coordinates file. 
     327 
     328 
     329            CALL iom_open( cn_coords_file(ib_bdy), inum ) 
     330            jpbdta = 1 
     331            DO igrd = 1, jpbgrd 
     332               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )   
     333               nblendta(igrd,ib_bdy) = kdimsz(1) 
     334               jpbdta = MAX(jpbdta, kdimsz(1)) 
     335            ENDDO 
     336 
     337         ENDIF  
     338 
     339      ENDDO ! ib_bdy 
     340 
     341      ! Allocate arrays 
     342      !--------------- 
     343      ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    & 
     344         &      nbrdta(jpbdta, jpbgrd, nb_bdy) ) 
     345 
     346      ALLOCATE( dta_global(jpbdta, 1, jpk) ) 
     347 
     348      ! Calculate global boundary index arrays or read in from file 
     349      !------------------------------------------------------------ 
     350      REWIND( numnam )                     
     351      DO ib_bdy = 1, nb_bdy 
     352 
     353         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Calculate global index arrays from namelist parameters 
     354 
     355            ! No REWIND here because may need to read more than one nambdy_index namelist. 
     356            READ  ( numnam, nambdy_index ) 
     357 
     358            ! Automatic boundary definition: if nbdysegX = -1 
     359            ! set boundary to whole side of model domain. 
     360            IF( nbdysege == -1 ) THEN 
     361               nbdysege = 1 
     362               jpieob(1) = jpiglo - 1 
     363               jpjedt(1) = 2 
     364               jpjeft(1) = jpjglo - 1 
     365            ENDIF 
     366            IF( nbdysegw == -1 ) THEN 
     367               nbdysegw = 1 
     368               jpiwob(1) = 2 
     369               jpjwdt(1) = 2 
     370               jpjwft(1) = jpjglo - 1 
     371            ENDIF 
     372            IF( nbdysegn == -1 ) THEN 
     373               nbdysegn = 1 
     374               jpjnob(1) = jpjglo - 1 
     375               jpindt(1) = 2 
     376               jpinft(1) = jpiglo - 1 
     377            ENDIF 
     378            IF( nbdysegs == -1 ) THEN 
     379               nbdysegs = 1 
     380               jpjsob(1) = 2 
     381               jpisdt(1) = 2 
     382               jpisft(1) = jpiglo - 1 
     383            ENDIF 
     384 
     385            ! ------------ T points ------------- 
     386            igrd = 1   
     387            icount = 0 
     388            DO ir = 1, nn_rimwidth(ib_bdy) 
     389               ! east 
     390               DO iseg = 1, nbdysege 
     391                  DO ij = jpjedt(iseg), jpjeft(iseg) 
     392                     icount = icount + 1 
     393                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1 
     394                     nbjdta(icount, igrd, ib_bdy) = ij 
     395                     nbrdta(icount, igrd, ib_bdy) = ir 
     396                  ENDDO 
     397               ENDDO 
     398               ! west 
     399               DO iseg = 1, nbdysegw 
     400                  DO ij = jpjwdt(iseg), jpjwft(iseg) 
     401                     icount = icount + 1 
     402                     nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
     403                     nbjdta(icount, igrd, ib_bdy) = ij 
     404                     nbrdta(icount, igrd, ib_bdy) = ir 
     405                  ENDDO 
     406               ENDDO 
     407               ! north 
     408               DO iseg = 1, nbdysegn 
     409                  DO ii = jpindt(iseg), jpinft(iseg) 
     410                     icount = icount + 1 
     411                     nbidta(icount, igrd, ib_bdy) = ii 
     412                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1 
     413                     nbrdta(icount, igrd, ib_bdy) = ir 
     414                  ENDDO 
     415               ENDDO 
     416               ! south 
     417               DO iseg = 1, nbdysegs 
     418                  DO ii = jpisdt(iseg), jpisft(iseg) 
     419                     icount = icount + 1 
     420                     nbidta(icount, igrd, ib_bdy) = ii 
     421                     nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir + 1 
     422                     nbrdta(icount, igrd, ib_bdy) = ir 
     423                  ENDDO 
     424               ENDDO 
     425            ENDDO 
     426 
     427            ! ------------ U points ------------- 
     428            igrd = 2   
     429            icount = 0 
     430            DO ir = 1, nn_rimwidth(ib_bdy) 
     431               ! east 
     432               DO iseg = 1, nbdysege 
     433                  DO ij = jpjedt(iseg), jpjeft(iseg) 
     434                     icount = icount + 1 
     435                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir 
     436                     nbjdta(icount, igrd, ib_bdy) = ij 
     437                     nbrdta(icount, igrd, ib_bdy) = ir 
     438                  ENDDO 
     439               ENDDO 
     440               ! west 
     441               DO iseg = 1, nbdysegw 
     442                  DO ij = jpjwdt(iseg), jpjwft(iseg) 
     443                     icount = icount + 1 
     444                     nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
     445                     nbjdta(icount, igrd, ib_bdy) = ij 
     446                     nbrdta(icount, igrd, ib_bdy) = ir 
     447                  ENDDO 
     448               ENDDO 
     449               ! north 
     450               DO iseg = 1, nbdysegn 
     451                  DO ii = jpindt(iseg), jpinft(iseg) - 1 
     452                     icount = icount + 1 
     453                     nbidta(icount, igrd, ib_bdy) = ii 
     454                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1 
     455                     nbrdta(icount, igrd, ib_bdy) = ir 
     456                  ENDDO 
     457               ENDDO 
     458               ! south 
     459               DO iseg = 1, nbdysegs 
     460                  DO ii = jpisdt(iseg), jpisft(iseg) - 1 
     461                     icount = icount + 1 
     462                     nbidta(icount, igrd, ib_bdy) = ii 
     463                     nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir + 1 
     464                     nbrdta(icount, igrd, ib_bdy) = ir 
     465                  ENDDO 
     466               ENDDO 
     467            ENDDO 
     468 
     469            ! ------------ V points ------------- 
     470            igrd = 3   
     471            icount = 0 
     472            DO ir = 1, nn_rimwidth(ib_bdy) 
     473               ! east 
     474               DO iseg = 1, nbdysege 
     475                  DO ij = jpjedt(iseg), jpjeft(iseg) - 1 
     476                     icount = icount + 1 
     477                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1 
     478                     nbjdta(icount, igrd, ib_bdy) = ij 
     479                     nbrdta(icount, igrd, ib_bdy) = ir 
     480                  ENDDO 
     481               ENDDO 
     482               ! west 
     483               DO iseg = 1, nbdysegw 
     484                  DO ij = jpjwdt(iseg), jpjwft(iseg) - 1 
     485                     icount = icount + 1 
     486                     nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
     487                     nbjdta(icount, igrd, ib_bdy) = ij 
     488                     nbrdta(icount, igrd, ib_bdy) = ir 
     489                  ENDDO 
     490               ENDDO 
     491               ! north 
     492               DO iseg = 1, nbdysegn 
     493                  DO ii = jpindt(iseg), jpinft(iseg) 
     494                     icount = icount + 1 
     495                     nbidta(icount, igrd, ib_bdy) = ii 
     496                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir 
     497                     nbrdta(icount, igrd, ib_bdy) = ir 
     498                  ENDDO 
     499               ENDDO 
     500               ! south 
     501               DO iseg = 1, nbdysegs 
     502                  DO ii = jpisdt(iseg), jpisft(iseg) 
     503                     icount = icount + 1 
     504                     nbidta(icount, igrd, ib_bdy) = ii 
     505                     nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir + 1 
     506                     nbrdta(icount, igrd, ib_bdy) = ir 
     507                  ENDDO 
     508               ENDDO 
     509            ENDDO 
     510 
     511         ELSE            ! Read global index arrays from boundary coordinates file. 
     512 
     513            DO igrd = 1, jpbgrd 
     514               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     515               DO ii = 1,nblendta(igrd,ib_bdy) 
     516                  nbidta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     517               END DO 
     518               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     519               DO ii = 1,nblendta(igrd,ib_bdy) 
     520                  nbjdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     521               END DO 
     522               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     523               DO ii = 1,nblendta(igrd,ib_bdy) 
     524                  nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     525               END DO 
     526 
     527               ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 
     528               IF(lwp) WRITE(numout,*) 
     529               IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 
     530               IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth(ib_bdy) 
     531               IF (ibr_max < nn_rimwidth(ib_bdy))   & 
     532                     CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) ) 
     533 
     534            END DO 
     535            CALL iom_close( inum ) 
     536 
     537         ENDIF  
     538 
     539      ENDDO  
     540 
     541      ! Work out dimensions of boundary data on each processor 
     542      ! ------------------------------------------------------ 
     543      
     544      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2 
     545      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1 
     546      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
     547      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1 
     548 
     549      DO ib_bdy = 1, nb_bdy 
     550         DO igrd = 1, jpbgrd 
     551            icount  = 0 
     552            icountr = 0 
     553            idx_bdy(ib_bdy)%nblen(igrd)    = 0 
     554            idx_bdy(ib_bdy)%nblenrim(igrd) = 0 
     555            DO ib = 1, nblendta(igrd,ib_bdy) 
     556               ! check that data is in correct order in file 
     557               ibm1 = MAX(1,ib-1) 
     558               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc... 
     559                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 
     560                     CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 
     561                                   'A utility for re-ordering boundary coordinates and data files exists in CDFTOOLS') 
     562                  ENDIF     
     563               ENDIF 
     564               ! check if point is in local domain 
     565               IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
     566                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN 
     567                  ! 
     568                  icount = icount  + 1 
     569                  ! 
     570                  IF( nbrdta(ib,igrd,ib_bdy) == 1 )   icountr = icountr+1 
     571               ENDIF 
     572            ENDDO 
     573            idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 
     574            idx_bdy(ib_bdy)%nblen   (igrd) = icount  !: length of boundary data on each proc         
     575         ENDDO  ! igrd 
     576 
     577         ! Allocate index arrays for this boundary set 
     578         !-------------------------------------------- 
     579         ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 
     580         ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 
     581         ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 
     582         ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 
     583         ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 
     584         ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 
     585         ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1) ) 
     586         ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1) ) 
     587 
     588         ! Dispatch mapping indices and discrete distances on each processor 
     589         ! ----------------------------------------------------------------- 
     590 
     591         DO igrd = 1, jpbgrd 
     592            icount  = 0 
     593            ! Loop on rimwidth to ensure outermost points come first in the local arrays. 
     594            DO ir=1, nn_rimwidth(ib_bdy) 
     595               DO ib = 1, nblendta(igrd,ib_bdy) 
     596                  ! check if point is in local domain and equals ir 
     597                  IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
     598                     & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   & 
     599                     & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     600                     ! 
     601                     icount = icount  + 1 
     602                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
     603                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
     604                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy) 
     605                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib 
     606                  ENDIF 
     607               ENDDO 
     608            ENDDO 
     609         ENDDO  
     610 
     611         ! Compute rim weights for FRS scheme 
     612         ! ---------------------------------- 
     613         DO igrd = 1, jpbgrd 
     614            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
     615               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
     616               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation 
     617!              idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth))**2      ! quadratic 
     618!              idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth)          ! linear 
     619            END DO 
     620         END DO  
     621 
     622      ENDDO 
     623 
     624      ! ------------------------------------------------------ 
     625      ! Initialise masks and find normal/tangential directions 
     626      ! ------------------------------------------------------ 
    151627 
    152628      ! Read global 2D mask at T-points: bdytmask 
    153       ! ***************************************** 
     629      ! ----------------------------------------- 
    154630      ! bdytmask = 1  on the computational domain AND on open boundaries 
    155631      !          = 0  elsewhere    
    … …  
    158634         zmask(         :                ,:) = 0.e0 
    159635         zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0           
    160       ELSE IF( ln_mask ) THEN 
    161          CALL iom_open( cn_mask, inum ) 
     636      ELSE IF( ln_mask_file ) THEN 
     637         CALL iom_open( cn_mask_file, inum ) 
    162638         CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) 
    163639         CALL iom_close( inum ) 
    … …  
    184660 
    185661 
    186       ! Read discrete distance and mapping indices 
    187       ! ****************************************** 
    188       nbidta(:,:) = 0.e0 
    189       nbjdta(:,:) = 0.e0 
    190       nbrdta(:,:) = 0.e0 
    191  
    192       IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 
    193          icount = 0 
    194          DO ir = 1, nn_rimwidth                  ! Define west boundary (from ii=2 to ii=1+nn_rimwidth): 
    195             DO ij = 3, jpjglo-2 
    196                icount = icount + 1 
    197                nbidta(icount,:) = ir + 1 + (jpizoom-1) 
    198                nbjdta(icount,:) = ij     + (jpjzoom-1)  
    199                nbrdta(icount,:) = ir 
    200             END DO 
    201          END DO 
    202          ! 
    203          DO ir = 1, nn_rimwidth                  ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nn_rimwidth): 
    204             DO ij=3,jpjglo-2 
    205                icount = icount + 1 
    206                nbidta(icount,:) = jpiglo-ir + (jpizoom-1) 
    207                nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points 
    208                nbjdta(icount,:) = ij + (jpjzoom-1) 
    209                nbrdta(icount,:) = ir 
    210             END DO 
    211          END DO 
    212          !        
    213       ELSE            ! Read indices and distances in unstructured boundary data files  
    214          ! 
    215          IF( ln_tides ) THEN             ! Read tides input files for preference in case there are no bdydata files 
    216             clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 
    217             clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 
    218             clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 
    219          ENDIF 
    220          IF( ln_dyn_fla .AND. .NOT. ln_tides ) THEN  
    221             clfile(4) = cn_dta_fla_T 
    222             clfile(5) = cn_dta_fla_U 
    223             clfile(6) = cn_dta_fla_V 
    224          ENDIF 
    225  
    226          IF( ln_tra_frs ) THEN  
    227             clfile(1) = cn_dta_frs_T 
    228             IF( .NOT. ln_dyn_frs ) THEN  
    229                clfile(2) = cn_dta_frs_T     ! Dummy read re read T file for sake of 6 files 
    230                clfile(3) = cn_dta_frs_T     ! 
    231             ENDIF 
    232          ENDIF           
    233          IF( ln_dyn_frs ) THEN  
    234             IF( .NOT. ln_tra_frs )   clfile(1) = cn_dta_frs_U      ! Dummy Read  
    235             clfile(2) = cn_dta_frs_U 
    236             clfile(3) = cn_dta_frs_V  
    237          ENDIF 
    238  
    239          !                                   ! how many files are we to read in? 
    240          IF(ln_tides .OR. ln_dyn_fla)   igrd_start = 4 
    241          ! 
    242          IF(ln_tra_frs    ) THEN   ;   igrd_start = 1 
    243          ELSEIF(ln_dyn_frs) THEN   ;   igrd_start = 2 
    244          ENDIF 
    245          ! 
    246          IF( ln_tra_frs   )   igrd_end = 1 
    247          ! 
    248          IF(ln_dyn_fla .OR. ln_tides) THEN   ;   igrd_end = 6 
    249          ELSEIF( ln_dyn_frs             ) THEN   ;   igrd_end = 3 
    250          ENDIF 
    251  
    252          DO igrd = igrd_start, igrd_end 
    253             CALL iom_open( clfile(igrd), inum ) 
    254             id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz )   
    255             IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz 
    256             ib_len = kdimsz(1) 
    257             IF( ib_len > jpbdta)   CALL ctl_stop(  'Boundary data array in file too long.',                  & 
    258                 &                                  'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' ) 
    259  
    260             CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) ) 
    261             DO ii = 1,ib_len 
    262                nbidta(ii,igrd) = INT( zdta(ii,1) ) 
    263             END DO 
    264             CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) ) 
    265             DO ii = 1,ib_len 
    266                nbjdta(ii,igrd) = INT( zdta(ii,1) ) 
    267             END DO 
    268             CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) ) 
    269             DO ii = 1,ib_len 
    270                nbrdta(ii,igrd) = INT( zdta(ii,1) ) 
    271             END DO 
    272             CALL iom_close( inum ) 
    273  
    274             IF( igrd < 4) THEN            ! Check that rimwidth in file is big enough for Frs case(barotropic is one): 
    275                ibr_max = MAXVAL( nbrdta(:,igrd) ) 
    276                IF(lwp) WRITE(numout,*) 
    277                IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 
    278                IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth 
    279                IF (ibr_max < nn_rimwidth)   CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file' ) 
    280             ENDIF !Check igrd < 4 
    281             ! 
    282          END DO 
    283          ! 
    284       ENDIF  
    285  
    286       ! Dispatch mapping indices and discrete distances on each processor 
    287       ! ***************************************************************** 
    288       
    289       iw = mig(1) + 1            ! if monotasking and no zoom, iw=2 
    290       ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1 
    291       is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    292       in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1 
    293  
    294       DO igrd = igrd_start, igrd_end 
    295          icount  = 0 
    296          icountr = 0 
    297          nblen   (igrd) = 0 
    298          nblenrim(igrd) = 0 
    299          nblendta(igrd) = 0 
    300          DO ir=1, nn_rimwidth 
    301             DO ib = 1, jpbdta 
    302                ! check if point is in local domain and equals ir 
    303                IF(  nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND.   & 
    304                   & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND.   & 
    305                   & nbrdta(ib,igrd) == ir  ) THEN 
    306                   ! 
    307                   icount = icount  + 1 
    308                   ! 
    309                   IF( ir == 1 )   icountr = icountr+1 
    310                   IF (icount > jpbdim) THEN 
    311                      IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small' 
    312                      nstop = nstop + 1 
    313                   ELSE 
    314                      nbi(icount, igrd)  = nbidta(ib,igrd)- mig(1)+1 
    315                      nbj(icount, igrd)  = nbjdta(ib,igrd)- mjg(1)+1 
    316                      nbr(icount, igrd)  = nbrdta(ib,igrd) 
    317                      nbmap(icount,igrd) = ib 
    318                   ENDIF             
    319                ENDIF 
    320             END DO 
    321          END DO 
    322          nblenrim(igrd) = icountr !: length of rim boundary data on each proc 
    323          nblen   (igrd) = icount  !: length of boundary data on each proc         
    324       END DO  
    325  
    326       ! Compute rim weights 
    327       ! ------------------- 
    328       DO igrd = igrd_start, igrd_end 
    329          DO ib = 1, nblen(igrd) 
    330             nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 )                     ! tanh formulation 
    331 !           nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth))**2      ! quadratic 
    332 !           nbw(ib,igrd) =  FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth)          ! linear 
    333          END DO 
    334       END DO  
    335     
    336662      ! Mask corrections 
    337663      ! ---------------- 
    … …  
    361687      ! bdy masks and bmask are now set to zero on boundary points: 
    362688      igrd = 1       ! In the free surface case, bmask is at T-points 
    363       DO ib = 1, nblenrim(igrd)      
    364         bmask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 
    365       END DO 
     689      DO ib_bdy = 1, nb_bdy 
     690        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)      
     691          bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
     692        ENDDO 
     693      ENDDO 
    366694      ! 
    367695      igrd = 1 
    368       DO ib = 1, nblenrim(igrd)       
    369         bdytmask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 
    370       END DO 
     696      DO ib_bdy = 1, nb_bdy 
     697        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)       
     698          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
     699        ENDDO 
     700      ENDDO 
    371701      ! 
    372702      igrd = 2 
    373       DO ib = 1, nblenrim(igrd) 
    374         bdyumask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 
    375       END DO 
     703      DO ib_bdy = 1, nb_bdy 
     704        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     705          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
     706        ENDDO 
     707      ENDDO 
    376708      ! 
    377709      igrd = 3 
    378       DO ib = 1, nblenrim(igrd) 
    379         bdyvmask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 
    380       END DO 
     710      DO ib_bdy = 1, nb_bdy 
     711        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     712          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
     713        ENDDO 
     714      ENDDO 
    381715 
    382716      ! Lateral boundary conditions 
    … …  
    384718      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 
    385719 
    386       IF( ln_vol .OR. ln_dyn_fla ) THEN      ! Indices and directions of rim velocity components 
    387          ! 
     720      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
     721 
     722         idx_bdy(ib_bdy)%flagu(:) = 0.e0 
     723         idx_bdy(ib_bdy)%flagv(:) = 0.e0 
     724         icount = 0  
     725 
    388726         !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 
    389727         !flagu =  0 : u is tangential 
    390728         !flagu =  1 : u is normal to the boundary and is direction is inward 
    391          icount = 0  
    392          flagu(:) = 0.e0 
    393   
     729   
    394730         igrd = 2      ! u-component  
    395          DO ib = 1, nblenrim(igrd)   
    396             zefl=bdytmask(nbi(ib,igrd)  , nbj(ib,igrd)) 
    397             zwfl=bdytmask(nbi(ib,igrd)+1, nbj(ib,igrd)) 
    398             IF( zefl + zwfl ==2 ) THEN 
    399                icount = icount +1 
     731         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     732            nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     733            nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     734            zefl = bdytmask(nbi  ,nbj) 
     735            zwfl = bdytmask(nbi+1,nbj) 
     736            IF( zefl + zwfl == 2 ) THEN 
     737               icount = icount + 1 
    400738            ELSE 
    401                flagu(ib)=-zefl+zwfl 
     739               idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl 
    402740            ENDIF 
    403741         END DO 
    … …  
    406744         !flagv =  0 : u is tangential 
    407745         !flagv =  1 : u is normal to the boundary and is direction is inward 
    408          flagv(:) = 0.e0 
    409746 
    410747         igrd = 3      ! v-component 
    411          DO ib = 1, nblenrim(igrd)   
    412             znfl = bdytmask(nbi(ib,igrd), nbj(ib,igrd)) 
    413             zsfl = bdytmask(nbi(ib,igrd), nbj(ib,igrd)+1) 
    414             IF( znfl + zsfl ==2 ) THEN 
     748         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     749            nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     750            nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     751            znfl = bdytmask(nbi,nbj  ) 
     752            zsfl = bdytmask(nbi,nbj+1) 
     753            IF( znfl + zsfl == 2 ) THEN 
    415754               icount = icount + 1 
    416755            ELSE 
    417                flagv(ib) = -znfl + zsfl 
     756               idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl 
    418757            END IF 
    419758         END DO 
    … …  
    422761            IF(lwp) WRITE(numout,*) 
    423762            IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,',   & 
    424                ' are not boundary points. Check nbi, nbj, indices.' 
     763               ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy 
    425764            IF(lwp) WRITE(numout,*) ' ========== ' 
    426765            IF(lwp) WRITE(numout,*) 
    … …  
    428767         ENDIF  
    429768     
    430       ENDIF 
     769      ENDDO 
    431770 
    432771      ! Compute total lateral surface for volume correction: 
    … …  
    435774      IF( ln_vol ) THEN   
    436775         igrd = 2      ! Lateral surface at U-points 
    437          DO ib = 1, nblenrim(igrd) 
    438             bdysurftot = bdysurftot + hu     (nbi(ib,igrd)  ,nbj(ib,igrd))                      & 
    439                &                    * e2u    (nbi(ib,igrd)  ,nbj(ib,igrd)) * ABS( flagu(ib) )   & 
    440                &                    * tmask_i(nbi(ib,igrd)  ,nbj(ib,igrd))                      & 
    441                &                    * tmask_i(nbi(ib,igrd)+1,nbj(ib,igrd))                    
    442          END DO 
     776         DO ib_bdy = 1, nb_bdy 
     777            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     778               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     779               nbj => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     780               flagu => idx_bdy(ib_bdy)%flagu(ib) 
     781               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
     782                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
     783                  &                    * tmask_i(nbi  , nbj)                           & 
     784                  &                    * tmask_i(nbi+1, nbj)                    
     785            ENDDO 
     786         ENDDO 
    443787 
    444788         igrd=3 ! Add lateral surface at V-points 
    445          DO ib = 1, nblenrim(igrd) 
    446             bdysurftot = bdysurftot + hv     (nbi(ib,igrd),nbj(ib,igrd)  )                      & 
    447                &                    * e1v    (nbi(ib,igrd),nbj(ib,igrd)  ) * ABS( flagv(ib) )   & 
    448                &                    * tmask_i(nbi(ib,igrd),nbj(ib,igrd)  )                      & 
    449                &                    * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 
    450          END DO 
     789         DO ib_bdy = 1, nb_bdy 
     790            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     791               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     792               nbj => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     793               flagv => idx_bdy(ib_bdy)%flagv(ib) 
     794               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
     795                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
     796                  &                    * tmask_i(nbi, nbj  )                           & 
     797                  &                    * tmask_i(nbi, nbj+1) 
     798            ENDDO 
     799         ENDDO 
    451800         ! 
    452801         IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain 
    453802      END IF    
    454  
    455       ! Initialise bdy data arrays 
    456       ! -------------------------- 
    457       tbdy(:,:) = 0.e0 
    458       sbdy(:,:) = 0.e0 
    459       ubdy(:,:) = 0.e0 
    460       vbdy(:,:) = 0.e0 
    461       sshbdy(:) = 0.e0 
    462       ubtbdy(:) = 0.e0 
    463       vbtbdy(:) = 0.e0 
    464 #if defined key_lim2 
    465       frld_bdy(:) = 0.e0 
    466       hicif_bdy(:) = 0.e0 
    467       hsnif_bdy(:) = 0.e0 
    468 #endif 
    469  
    470       ! Read in tidal constituents and adjust for model start time 
    471       ! ---------------------------------------------------------- 
    472       IF( ln_tides )   CALL tide_data 
    473803      ! 
     804      ! Tidy up 
     805      !-------- 
     806      DEALLOCATE(nbidta, nbjdta, nbrdta) 
     807 
    474808   END SUBROUTINE bdy_init 
    475809 
    476810#else 
    477811   !!--------------------------------------------------------------------------------- 
    478    !!   Dummy module                                   NO unstructured open boundaries 
     812   !!   Dummy module                                   NO open boundaries 
    479813   !!--------------------------------------------------------------------------------- 
    480814CONTAINS 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r2528 r3116  
    1111#if defined key_bdy 
    1212   !!---------------------------------------------------------------------- 
    13    !!   'key_bdy'     Unstructured Open Boundary Condition 
     13   !!   'key_bdy'     Open Boundary Condition 
    1414   !!---------------------------------------------------------------------- 
    1515   !!   PUBLIC 
    16    !!      tide_init     : read of namelist 
    17    !!      tide_data     : read in and initialisation of tidal constituents at boundary 
     16   !!      tide_init     : read of namelist and initialisation of tidal harmonics data 
    1817   !!      tide_update   : calculation of tidal forcing at each timestep 
    1918   !!   PRIVATE 
    … …  
    3332   USE bdy_oce         ! ocean open boundary conditions 
    3433   USE daymod          ! calendar 
     34   USE fldread, ONLY: fld_map 
    3535 
    3636   IMPLICIT NONE 
    3737   PRIVATE 
    3838 
    39    PUBLIC   tide_init     ! routine called in bdyini 
    40    PUBLIC   tide_data     ! routine called in bdyini 
     39   PUBLIC   tide_init     ! routine called in nemo_init 
    4140   PUBLIC   tide_update   ! routine called in bdydyn 
    4241 
    43    LOGICAL, PUBLIC            ::   ln_tide_date          !: =T correct tide phases and amplitude for model start date 
    44    INTEGER, PUBLIC, PARAMETER ::   jptides_max = 15      !: Max number of tidal contituents 
    45    INTEGER, PUBLIC            ::   ntide                 !: Actual number of tidal constituents 
    46  
    47    CHARACTER(len=80), PUBLIC                         ::   filtide    !: Filename root for tidal input files 
    48    CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) ::   tide_cpt   !: Names of tidal components used. 
    49  
    50    INTEGER , PUBLIC, DIMENSION(jptides_max) ::   nindx        !: ??? 
    51    REAL(wp), PUBLIC, DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr) 
    52     
    53    REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   ssh1, ssh2   ! Tidal constituents : SSH 
    54    REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   u1  , u2     ! Tidal constituents : U 
    55    REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   v1  , v2     ! Tidal constituents : V 
     42   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data 
     43      INTEGER                                ::   ncpt       !: Actual number of tidal components 
     44      REAL(wp), POINTER, DIMENSION(:)        ::   speed      !: Phase speed of tidal constituent (deg/hr) 
     45      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH 
     46      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U 
     47      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V 
     48   END TYPE TIDES_DATA 
     49 
     50   INTEGER, PUBLIC, PARAMETER                  ::   jptides_max = 15      !: Max number of tidal contituents 
     51 
     52   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET ::   tides                 !: External tidal harmonics data 
    5653    
    5754   !!---------------------------------------------------------------------- 
    … …  
    6663      !!                    ***  SUBROUTINE tide_init  *** 
    6764      !!                      
    68       !! ** Purpose : - Read in namelist for tides 
    69       !! 
    70       !!---------------------------------------------------------------------- 
    71       INTEGER ::   itide                  ! dummy loop index  
     65      !! ** Purpose : - Read in namelist for tides and initialise external 
     66      !!                tidal harmonics data 
     67      !! 
     68      !!---------------------------------------------------------------------- 
     69      !! namelist variables 
     70      !!------------------- 
     71      LOGICAL                                   ::   ln_tide_date !: =T correct tide phases and amplitude for model start date 
     72      CHARACTER(len=80)                         ::   filtide      !: Filename root for tidal input files 
     73      CHARACTER(len= 4), DIMENSION(jptides_max) ::   tide_cpt     !: Names of tidal components used. 
     74      REAL(wp),          DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr) 
     75      !! 
     76      INTEGER, DIMENSION(jptides_max)           ::   nindx              !: index of pre-set tidal components 
     77      INTEGER                                   ::   ib_bdy, itide, ib  !: dummy loop indices 
     78      INTEGER                                   ::   inum, igrd 
     79      INTEGER, DIMENSION(3)                     ::   ilen0              !: length of boundary data (from OBC arrays) 
     80      CHARACTER(len=80)                         ::   clfile             !: full file name for tidal input file  
     81      REAL(wp)                                  ::   z_arg, z_atde, z_btde, z1t, z2t            
     82      REAL(wp),DIMENSION(jptides_max)           ::   z_vplu, z_ftc 
     83      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read           !: work space to read in tidal harmonics data 
     84      !! 
     85      TYPE(TIDES_DATA),  POINTER                ::   td                 !: local short cut    
    7286      !! 
    7387      NAMELIST/nambdy_tide/ln_tide_date, filtide, tide_cpt, tide_speed 
    … …  
    7892      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    7993 
    80       ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
    81       ln_tide_date = .false. 
    82       filtide(:) = '' 
    83       tide_speed(:) = 0.0 
    84       tide_cpt(:) = '' 
    85       REWIND( numnam )                                ! Read namelist parameters 
    86       READ  ( numnam, nambdy_tide ) 
    87       !                                               ! Count number of components specified 
    88       ntide = jptides_max 
    89       DO itide = 1, jptides_max 
    90         IF( tide_cpt(itide) == '' ) THEN 
    91            ntide = itide-1 
    92            exit 
    93         ENDIF 
    94       END DO 
    95  
    96       !                                               ! find constituents in standard list 
    97       DO itide = 1, ntide 
    98          nindx(itide) = 0 
    99          IF( TRIM( tide_cpt(itide) ) == 'Q1'  )   nindx(itide) =  1 
    100          IF( TRIM( tide_cpt(itide) ) == 'O1'  )   nindx(itide) =  2 
    101          IF( TRIM( tide_cpt(itide) ) == 'P1'  )   nindx(itide) =  3 
    102          IF( TRIM( tide_cpt(itide) ) == 'S1'  )   nindx(itide) =  4 
    103          IF( TRIM( tide_cpt(itide) ) == 'K1'  )   nindx(itide) =  5 
    104          IF( TRIM( tide_cpt(itide) ) == '2N2' )   nindx(itide) =  6 
    105          IF( TRIM( tide_cpt(itide) ) == 'MU2' )   nindx(itide) =  7 
    106          IF( TRIM( tide_cpt(itide) ) == 'N2'  )   nindx(itide) =  8 
    107          IF( TRIM( tide_cpt(itide) ) == 'NU2' )   nindx(itide) =  9 
    108          IF( TRIM( tide_cpt(itide) ) == 'M2'  )   nindx(itide) = 10 
    109          IF( TRIM( tide_cpt(itide) ) == 'L2'  )   nindx(itide) = 11 
    110          IF( TRIM( tide_cpt(itide) ) == 'T2'  )   nindx(itide) = 12 
    111          IF( TRIM( tide_cpt(itide) ) == 'S2'  )   nindx(itide) = 13 
    112          IF( TRIM( tide_cpt(itide) ) == 'K2'  )   nindx(itide) = 14 
    113          IF( TRIM( tide_cpt(itide) ) == 'M4'  )   nindx(itide) = 15 
    114          IF( nindx(itide) == 0  .AND. lwp ) THEN 
    115             WRITE(ctmp1,*) 'constitunent', itide,':', tide_cpt(itide), 'not in standard list' 
    116             CALL ctl_warn( ctmp1 ) 
    117          ENDIF 
    118       END DO 
    119       !                                               ! Parameter control and print 
    120       IF( ntide < 1 ) THEN  
    121          CALL ctl_stop( '          Did not find any tidal components in namelist nambdy_tide' ) 
    122       ELSE 
    123          IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 
    124          IF(lwp) WRITE(numout,*) '             tidal components specified ', ntide 
    125          IF(lwp) WRITE(numout,*) '                ', tide_cpt(1:ntide) 
    126          IF(lwp) WRITE(numout,*) '             associated phase speeds (deg/hr) : ' 
    127          IF(lwp) WRITE(numout,*) '                ', tide_speed(1:ntide) 
    128       ENDIF 
    129  
    130       ! Initialisation of tidal harmonics arrays 
    131       sshtide(:) = 0.e0 
    132       utide  (:) = 0.e0 
    133       vtide  (:) = 0.e0 
    134       ! 
     94      REWIND(numnam) 
     95      DO ib_bdy = 1, nb_bdy 
     96         IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
     97 
     98            td => tides(ib_bdy) 
     99 
     100            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
     101            ln_tide_date = .false. 
     102            filtide(:) = '' 
     103            tide_speed(:) = 0.0 
     104            tide_cpt(:) = '' 
     105 
     106            ! Don't REWIND here - may need to read more than one of these namelists. 
     107            READ  ( numnam, nambdy_tide ) 
     108            !                                               ! Count number of components specified 
     109            td%ncpt = 0 
     110            DO itide = 1, jptides_max 
     111              IF( tide_cpt(itide) /= '' ) THEN 
     112                 td%ncpt = td%ncpt + 1 
     113              ENDIF 
     114            END DO 
     115 
     116            ! Fill in phase speeds from namelist 
     117            ALLOCATE( td%speed(td%ncpt) ) 
     118            td%speed = tide_speed(1:td%ncpt) 
     119 
     120            ! Find constituents in standard list 
     121            DO itide = 1, td%ncpt 
     122               nindx(itide) = 0 
     123               IF( TRIM( tide_cpt(itide) ) == 'Q1'  )   nindx(itide) =  1 
     124               IF( TRIM( tide_cpt(itide) ) == 'O1'  )   nindx(itide) =  2 
     125               IF( TRIM( tide_cpt(itide) ) == 'P1'  )   nindx(itide) =  3 
     126               IF( TRIM( tide_cpt(itide) ) == 'S1'  )   nindx(itide) =  4 
     127               IF( TRIM( tide_cpt(itide) ) == 'K1'  )   nindx(itide) =  5 
     128               IF( TRIM( tide_cpt(itide) ) == '2N2' )   nindx(itide) =  6 
     129               IF( TRIM( tide_cpt(itide) ) == 'MU2' )   nindx(itide) =  7 
     130               IF( TRIM( tide_cpt(itide) ) == 'N2'  )   nindx(itide) =  8 
     131               IF( TRIM( tide_cpt(itide) ) == 'NU2' )   nindx(itide) =  9 
     132               IF( TRIM( tide_cpt(itide) ) == 'M2'  )   nindx(itide) = 10 
     133               IF( TRIM( tide_cpt(itide) ) == 'L2'  )   nindx(itide) = 11 
     134               IF( TRIM( tide_cpt(itide) ) == 'T2'  )   nindx(itide) = 12 
     135               IF( TRIM( tide_cpt(itide) ) == 'S2'  )   nindx(itide) = 13 
     136               IF( TRIM( tide_cpt(itide) ) == 'K2'  )   nindx(itide) = 14 
     137               IF( TRIM( tide_cpt(itide) ) == 'M4'  )   nindx(itide) = 15 
     138               IF( nindx(itide) == 0  .AND. lwp ) THEN 
     139                  WRITE(ctmp1,*) 'constitunent', itide,':', tide_cpt(itide), 'not in standard list' 
     140                  CALL ctl_warn( ctmp1 ) 
     141               ENDIF 
     142            END DO 
     143            !                                               ! Parameter control and print 
     144            IF( td%ncpt < 1 ) THEN  
     145               CALL ctl_stop( '          Did not find any tidal components in namelist nambdy_tide' ) 
     146            ELSE 
     147               IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 
     148               IF(lwp) WRITE(numout,*) '             tidal components specified ', td%ncpt 
     149               IF(lwp) WRITE(numout,*) '                ', tide_cpt(1:td%ncpt) 
     150               IF(lwp) WRITE(numout,*) '             associated phase speeds (deg/hr) : ' 
     151               IF(lwp) WRITE(numout,*) '                ', tide_speed(1:td%ncpt) 
     152            ENDIF 
     153 
     154 
     155            ! Allocate space for tidal harmonics data -  
     156            ! get size from OBC data arrays 
     157            ! --------------------------------------- 
     158 
     159            ilen0(1) = SIZE( dta_bdy(ib_bdy)%ssh )  
     160            ALLOCATE( td%ssh( ilen0(1), td%ncpt, 2 ) ) 
     161 
     162            ilen0(2) = SIZE( dta_bdy(ib_bdy)%u2d )  
     163            ALLOCATE( td%u( ilen0(2), td%ncpt, 2 ) ) 
     164 
     165            ilen0(3) = SIZE( dta_bdy(ib_bdy)%v2d )  
     166            ALLOCATE( td%v( ilen0(3), td%ncpt, 2 ) ) 
     167 
     168            ALLOCATE( dta_read( MAXVAL(ilen0), 1, 1 ) ) 
     169 
     170 
     171            ! Open files and read in tidal forcing data 
     172            ! ----------------------------------------- 
     173 
     174            DO itide = 1, td%ncpt 
     175               !                                                              ! SSH fields 
     176               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_T.nc' 
     177               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 
     178               CALL iom_open( clfile, inum ) 
     179               CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     180               td%ssh(:,itide,1) = dta_read(1:ilen0(1),1,1) 
     181               CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     182               td%ssh(:,itide,2) = dta_read(1:ilen0(1),1,1) 
     183               CALL iom_close( inum ) 
     184               !                                                              ! U fields 
     185               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_U.nc' 
     186               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 
     187               CALL iom_open( clfile, inum ) 
     188               CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     189               td%u(:,itide,1) = dta_read(1:ilen0(2),1,1) 
     190               CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     191               td%u(:,itide,2) = dta_read(1:ilen0(2),1,1) 
     192               CALL iom_close( inum ) 
     193               !                                                              ! V fields 
     194               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_V.nc' 
     195               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 
     196               CALL iom_open( clfile, inum ) 
     197               CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     198               td%v(:,itide,1) = dta_read(1:ilen0(3),1,1) 
     199               CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     200               td%v(:,itide,2) = dta_read(1:ilen0(3),1,1) 
     201               CALL iom_close( inum ) 
     202               ! 
     203            END DO ! end loop on tidal components 
     204 
     205            IF( ln_tide_date ) THEN      ! correct for date factors 
     206 
     207!! used nmonth, nyear and nday from daymod.... 
     208               ! Calculate date corrects for 15 standard consituents 
     209               ! This is the initialisation step, so nday, nmonth, nyear are the  
     210               ! initial date/time of the integration. 
     211                 print *, nday,nmonth,nyear 
     212                 nyear  = int(ndate0 / 10000  )                          ! initial year 
     213                 nmonth = int((ndate0 - nyear * 10000 ) / 100 )          ! initial month 
     214                 nday   = int(ndate0 - nyear * 10000 - nmonth * 100) 
     215 
     216               CALL uvset( 0, nday, nmonth, nyear, z_ftc, z_vplu ) 
     217 
     218               IF(lwp) WRITE(numout,*) 'Correcting tide for date:', nday, nmonth, nyear 
     219 
     220               DO itide = 1, td%ncpt       ! loop on tidal components 
     221                  ! 
     222                  IF( nindx(itide) /= 0 ) THEN 
     223!!gm use rpi  and rad global variable   
     224                     z_arg = 3.14159265d0 * z_vplu(nindx(itide)) / 180.0d0 
     225                     z_atde=z_ftc(nindx(itide))*cos(z_arg) 
     226                     z_btde=z_ftc(nindx(itide))*sin(z_arg) 
     227                     IF(lwp) WRITE(numout,'(2i5,8f10.6)') itide, nindx(itide), td%speed(itide),   & 
     228                        &                                 z_ftc(nindx(itide)), z_vplu(nindx(itide)) 
     229                  ELSE 
     230                     z_atde = 1.0_wp 
     231                     z_btde = 0.0_wp 
     232                  ENDIF 
     233                  !                                         !  elevation          
     234                  igrd = 1 
     235                  DO ib = 1, ilen0(igrd)                 
     236                     z1t = z_atde * td%ssh(ib,itide,1) + z_btde * td%ssh(ib,itide,2) 
     237                     z2t = z_atde * td%ssh(ib,itide,2) - z_btde * td%ssh(ib,itide,1) 
     238                     td%ssh(ib,itide,1) = z1t 
     239                     td%ssh(ib,itide,2) = z2t 
     240                  END DO 
     241                  !                                         !  u        
     242                  igrd = 2 
     243                  DO ib = 1, ilen0(igrd)                 
     244                     z1t = z_atde * td%u(ib,itide,1) + z_btde * td%u(ib,itide,2) 
     245                     z2t = z_atde * td%u(ib,itide,2) - z_btde * td%u(ib,itide,1) 
     246                     td%u(ib,itide,1) = z1t 
     247                     td%u(ib,itide,2) = z2t 
     248                  END DO 
     249                  !                                         !  v        
     250                  igrd = 3 
     251                  DO ib = 1, ilen0(igrd)                 
     252                     z1t = z_atde * td%v(ib,itide,1) + z_btde * td%v(ib,itide,2) 
     253                     z2t = z_atde * td%v(ib,itide,2) - z_btde * td%v(ib,itide,1) 
     254                     td%v(ib,itide,1) = z1t 
     255                     td%v(ib,itide,2) = z2t 
     256                  END DO 
     257                  ! 
     258               END DO   ! end loop on tidal components 
     259               ! 
     260            ENDIF ! date correction 
     261            ! 
     262         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
     263         ! 
     264      END DO ! loop on ib_bdy 
     265 
    135266   END SUBROUTINE tide_init 
    136267 
    137268 
    138    SUBROUTINE tide_data 
    139       !!---------------------------------------------------------------------- 
    140       !!                    ***  SUBROUTINE tide_data  *** 
    141       !!                     
    142       !! ** Purpose : - Read in tidal harmonics data and adjust for the start  
    143       !!                time of the model run.  
    144       !! 
    145       !!---------------------------------------------------------------------- 
    146       INTEGER ::   itide, igrd, ib        ! dummy loop indices 
    147       CHARACTER(len=80) :: clfile         ! full file name for tidal input file  
    148       INTEGER ::   ipi, ipj, inum, idvar  ! temporary integers (netcdf read) 
    149       INTEGER, DIMENSION(6) :: lendta=0   ! length of data in the file (note may be different from nblendta!) 
    150       REAL(wp) ::  z_arg, z_atde, z_btde, z1t, z2t            
    151       REAL(wp), DIMENSION(jpbdta,1) ::   zdta   ! temporary array for data fields 
    152       REAL(wp), DIMENSION(jptides_max) :: z_vplu, z_ftc 
    153       !!------------------------------------------------------------------------------ 
    154  
    155       ! Open files and read in tidal forcing data 
    156       ! ----------------------------------------- 
    157  
    158       ipj = 1 
    159  
    160       DO itide = 1, ntide 
    161          !                                                              ! SSH fields 
    162          clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_T.nc' 
    163          IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 
    164          CALL iom_open( clfile, inum ) 
    165          igrd = 4 
    166          IF( nblendta(igrd) <= 0 ) THEN  
    167             idvar = iom_varid( inum,'z1' ) 
    168             IF(lwp) WRITE(numout,*) 'iom_file(1)%ndims(idvar) : ',iom_file%ndims(idvar) 
    169             nblendta(igrd) = iom_file(inum)%dimsz(1,idvar) 
    170             WRITE(numout,*) 'Dim size for z1 is ', nblendta(igrd) 
    171          ENDIF 
    172          ipi = nblendta(igrd) 
    173          CALL iom_get( inum, jpdom_unknown, 'z1', zdta(1:ipi,1:ipj) ) 
    174          DO ib = 1, nblenrim(igrd) 
    175             ssh1(ib,itide) = zdta(nbmap(ib,igrd),1) 
    176          END DO 
    177          CALL iom_get( inum, jpdom_unknown, 'z2', zdta(1:ipi,1:ipj) ) 
    178          DO ib = 1, nblenrim(igrd) 
    179             ssh2(ib,itide) = zdta(nbmap(ib,igrd),1) 
    180          END DO 
    181          CALL iom_close( inum ) 
    182          ! 
    183          !                                                              ! U fields 
    184          clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_U.nc' 
    185          IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 
    186          CALL iom_open( clfile, inum ) 
    187          igrd = 5 
    188          IF( lendta(igrd) <= 0 ) THEN  
    189             idvar = iom_varid( inum,'u1' ) 
    190             lendta(igrd) = iom_file(inum)%dimsz(1,idvar) 
    191             WRITE(numout,*) 'Dim size for u1 is ',lendta(igrd) 
    192          ENDIF 
    193          ipi = lendta(igrd) 
    194          CALL iom_get( inum, jpdom_unknown, 'u1', zdta(1:ipi,1:ipj) ) 
    195          DO ib = 1, nblenrim(igrd) 
    196             u1(ib,itide) = zdta(nbmap(ib,igrd),1) 
    197          END DO 
    198          CALL iom_get( inum, jpdom_unknown, 'u2', zdta(1:ipi,1:ipj) ) 
    199          DO ib = 1, nblenrim(igrd) 
    200             u2(ib,itide) = zdta(nbmap(ib,igrd),1) 
    201          END DO 
    202          CALL iom_close( inum ) 
    203          ! 
    204          !                                                              ! V fields 
    205          clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_V.nc' 
    206          if(lwp) write(numout,*) 'Reading data from file ', clfile 
    207          CALL iom_open( clfile, inum ) 
    208          igrd = 6 
    209          IF( lendta(igrd) <= 0 ) THEN  
    210             idvar = iom_varid( inum,'v1' ) 
    211             lendta(igrd) = iom_file(inum)%dimsz(1,idvar) 
    212             WRITE(numout,*) 'Dim size for v1 is ', lendta(igrd) 
    213          ENDIF 
    214          ipi = lendta(igrd) 
    215          CALL iom_get( inum, jpdom_unknown, 'v1', zdta(1:ipi,1:ipj) ) 
    216          DO ib = 1, nblenrim(igrd) 
    217             v1(ib,itide) = zdta(nbmap(ib,igrd),1) 
    218          END DO 
    219          CALL iom_get( inum, jpdom_unknown, 'v2', zdta(1:ipi,1:ipj) ) 
    220          DO ib=1, nblenrim(igrd) 
    221             v2(ib,itide) = zdta(nbmap(ib,igrd),1) 
    222          END DO 
    223          CALL iom_close( inum ) 
    224          ! 
    225       END DO ! end loop on tidal components 
    226  
    227       IF( ln_tide_date ) THEN      ! correct for date factors 
    228  
    229 !! used nmonth, nyear and nday from daymod.... 
    230          ! Calculate date corrects for 15 standard consituents 
    231          ! This is the initialisation step, so nday, nmonth, nyear are the  
    232          ! initial date/time of the integration. 
    233            print *, nday,nmonth,nyear 
    234            nyear  = int(ndate0 / 10000  )                           ! initial year 
    235            nmonth = int((ndate0 - nyear * 10000 ) / 100 )          ! initial month 
    236            nday   = int(ndate0 - nyear * 10000 - nmonth * 100) 
    237  
    238          CALL uvset( 0, nday, nmonth, nyear, z_ftc, z_vplu ) 
    239  
    240          IF(lwp) WRITE(numout,*) 'Correcting tide for date:', nday, nmonth, nyear 
    241  
    242          DO itide = 1, ntide       ! loop on tidal components 
    243             ! 
    244             IF( nindx(itide) /= 0 ) THEN 
    245 !!gm use rpi  and rad global variable   
    246                z_arg = 3.14159265d0 * z_vplu(nindx(itide)) / 180.0d0 
    247                z_atde=z_ftc(nindx(itide))*cos(z_arg) 
    248                z_btde=z_ftc(nindx(itide))*sin(z_arg) 
    249                IF(lwp) WRITE(numout,'(2i5,8f10.6)') itide, nindx(itide), tide_speed(itide),   & 
    250                   &                                 z_ftc(nindx(itide)), z_vplu(nindx(itide)) 
    251             ELSE 
    252                z_atde = 1.0_wp 
    253                z_btde = 0.0_wp 
    254             ENDIF 
    255             !                                         !  elevation          
    256             igrd = 4 
    257             DO ib = 1, nblenrim(igrd)                 
    258                z1t = z_atde * ssh1(ib,itide) + z_btde * ssh2(ib,itide) 
    259                z2t = z_atde * ssh2(ib,itide) - z_btde * ssh1(ib,itide) 
    260                ssh1(ib,itide) = z1t 
    261                ssh2(ib,itide) = z2t 
    262             END DO 
    263             !                                         !  u        
    264             igrd = 5 
    265             DO ib = 1, nblenrim(igrd)                 
    266                z1t = z_atde * u1(ib,itide) + z_btde * u2(ib,itide) 
    267                z2t = z_atde * u2(ib,itide) - z_btde * u1(ib,itide) 
    268                u1(ib,itide) = z1t 
    269                u2(ib,itide) = z2t 
    270             END DO 
    271             !                                         !  v        
    272             igrd = 6 
    273             DO ib = 1, nblenrim(igrd)                 
    274                z1t = z_atde * v1(ib,itide) + z_btde * v2(ib,itide) 
    275                z2t = z_atde * v2(ib,itide) - z_btde * v1(ib,itide) 
    276                v1(ib,itide) = z1t 
    277                v2(ib,itide) = z2t 
    278             END DO 
    279             ! 
    280          END DO   ! end loop on tidal components 
    281          ! 
    282       ENDIF ! date correction 
    283       ! 
    284    END SUBROUTINE tide_data 
    285  
    286  
    287    SUBROUTINE tide_update ( kt, jit ) 
     269   SUBROUTINE tide_update ( kt, idx, dta, td, jit, time_offset ) 
    288270      !!---------------------------------------------------------------------- 
    289271      !!                 ***  SUBROUTINE tide_update  *** 
    290272      !!                 
    291       !! ** Purpose : - Add tidal forcing to sshbdy, ubtbdy and vbtbdy arrays.  
     273      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.  
    292274      !!                 
    293275      !!---------------------------------------------------------------------- 
    294       INTEGER, INTENT( in ) ::   kt      ! Main timestep counter 
     276      INTEGER, INTENT( in )          ::   kt      ! Main timestep counter 
    295277!!gm doctor jit ==> kit 
    296       INTEGER, INTENT( in ) ::   jit     ! Barotropic timestep counter (for timesplitting option) 
    297       !! 
    298       INTEGER  ::   itide, igrd, ib      ! dummy loop indices 
    299       REAL(wp) ::   z_arg, z_sarg            !             
     278      TYPE(OBC_INDEX), INTENT( in )  ::   idx     ! OBC indices 
     279      TYPE(OBC_DATA),  INTENT(inout) ::   dta     ! OBC external data 
     280      TYPE(TIDES_DATA),INTENT( in )  ::   td      ! tidal harmonics data 
     281      INTEGER,INTENT(in),OPTIONAL    ::   jit     ! Barotropic timestep counter (for timesplitting option) 
     282      INTEGER,INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
     283                                                       ! is present then units = subcycle timesteps. 
     284                                                       ! time_offset = 0 => get data at "now" time level 
     285                                                       ! time_offset = -1 => get data at "before" time level 
     286                                                       ! time_offset = +1 => get data at "after" time level 
     287                                                       ! etc. 
     288      !! 
     289      INTEGER                          :: itide, igrd, ib      ! dummy loop indices 
     290      INTEGER                          :: time_add             ! time offset in units of timesteps 
     291      REAL(wp)                         :: z_arg, z_sarg       
    300292      REAL(wp), DIMENSION(jptides_max) :: z_sist, z_cost 
    301293      !!---------------------------------------------------------------------- 
    302294 
     295      time_add = 0 
     296      IF( PRESENT(time_offset) ) THEN 
     297         time_add = time_offset 
     298      ENDIF 
     299          
    303300      ! Note tide phase speeds are in deg/hour, so we need to convert the 
    304301      ! elapsed time in seconds to hours by dividing by 3600.0 
    305       IF( jit == 0 ) THEN   
    306          z_arg = kt * rdt * rad / 3600.0 
    307       ELSE                              ! we are in a barotropic subcycle (for timesplitting option) 
    308 !         z_arg = ( (kt-1) * rdt + jit * rdt / REAL(nn_baro,lwp) ) * rad / 3600.0 
    309          z_arg = ( (kt-1) * rdt + jit * rdt / REAL(nn_baro,wp) ) * rad / 3600.0 
     302      IF( PRESENT(jit) ) THEN   
     303         z_arg = ( (kt-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) ) * rad / 3600.0 
     304      ELSE                               
     305         z_arg = (kt+time_add) * rdt * rad / 3600.0 
    310306      ENDIF 
    311307 
    312       DO itide = 1, ntide 
    313          z_sarg = z_arg * tide_speed(itide) 
     308      DO itide = 1, td%ncpt 
     309         z_sarg = z_arg * td%speed(itide) 
    314310         z_cost(itide) = COS( z_sarg ) 
    315311         z_sist(itide) = SIN( z_sarg ) 
    316312      END DO 
    317313 
    318       ! summing of tidal constituents into BDY arrays 
    319       sshtide(:) = 0.0 
    320       utide (:) = 0.0 
    321       vtide (:) = 0.0 
    322       ! 
    323       DO itide = 1, ntide 
    324          igrd=4                              ! SSH on tracer grid. 
    325          DO ib = 1, nblenrim(igrd) 
    326             sshtide(ib) =sshtide(ib)+ ssh1(ib,itide)*z_cost(itide) + ssh2(ib,itide)*z_sist(itide) 
    327             !    if(lwp) write(numout,*) 'z',ib,itide,sshtide(ib), ssh1(ib,itide),ssh2(ib,itide) 
     314      DO itide = 1, td%ncpt 
     315         igrd=1                              ! SSH on tracer grid. 
     316         DO ib = 1, idx%nblenrim(igrd) 
     317            dta%ssh(ib) = dta%ssh(ib) + td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide) 
     318            !    if(lwp) write(numout,*) 'z', ib, itide, dta%ssh(ib), td%ssh(ib,itide,1),td%ssh(ib,itide,2) 
    328319         END DO 
    329          igrd=5                              ! U grid 
    330          DO ib=1, nblenrim(igrd) 
    331             utide(ib) = utide(ib)+ u1(ib,itide)*z_cost(itide) + u2(ib,itide)*z_sist(itide) 
    332             !    if(lwp) write(numout,*) 'u',ib,itide,utide(ib), u1(ib,itide),u2(ib,itide) 
     320         igrd=2                              ! U grid 
     321         DO ib=1, idx%nblenrim(igrd) 
     322            dta%u2d(ib) = dta%u2d(ib) + td%u(ib,itide,1)*z_cost(itide) + td%u(ib,itide,2)*z_sist(itide) 
     323            !    if(lwp) write(numout,*) 'u',ib,itide,utide(ib), td%u(ib,itide,1),td%u(ib,itide,2) 
    333324         END DO 
    334          igrd=6                              ! V grid 
    335          DO ib=1, nblenrim(igrd) 
    336             vtide(ib) = vtide(ib)+ v1(ib,itide)*z_cost(itide) + v2(ib,itide)*z_sist(itide) 
    337             !    if(lwp) write(numout,*) 'v',ib,itide,vtide(ib), v1(ib,itide),v2(ib,itide) 
     325         igrd=3                              ! V grid 
     326         DO ib=1, idx%nblenrim(igrd) 
     327            dta%v2d(ib) = dta%v2d(ib) + td%v(ib,itide,1)*z_cost(itide) + td%v(ib,itide,2)*z_sist(itide) 
     328            !    if(lwp) write(numout,*) 'v',ib,itide,vtide(ib), td%v(ib,itide,1),td%v(ib,itide,2) 
    338329         END DO 
    339330      END DO 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r2977 r3116  
    1111   !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    1212   !!---------------------------------------------------------------------- 
    13    !!   bdy_tra_frs        : Relaxation of tracers on unstructured open boundaries 
     13   !!   bdy_tra            : Apply open boundary conditions to T and S 
     14   !!   bdy_tra_frs        : Apply Flow Relaxation Scheme 
    1415   !!---------------------------------------------------------------------- 
    1516   USE oce             ! ocean dynamics and tracers variables 
    1617   USE dom_oce         ! ocean space and time domain variables  
    1718   USE bdy_oce         ! ocean open boundary conditions 
     19   USE bdydta, ONLY:   bf 
    1820   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    1921   USE in_out_manager  ! I/O manager 
    … …  
    2224   PRIVATE 
    2325 
    24    PUBLIC bdy_tra_frs     ! routine called in tranxt.F90  
     26   PUBLIC bdy_tra      ! routine called in tranxt.F90  
    2527 
    2628   !!---------------------------------------------------------------------- 
    … …  
    3133CONTAINS 
    3234 
    33    SUBROUTINE bdy_tra_frs( kt ) 
     35   SUBROUTINE bdy_tra( kt ) 
     36      !!---------------------------------------------------------------------- 
     37      !!                  ***  SUBROUTINE bdy_dyn3d  *** 
     38      !! 
     39      !! ** Purpose : - Apply open boundary conditions for baroclinic velocities 
     40      !! 
     41      !!---------------------------------------------------------------------- 
     42      INTEGER, INTENT( in ) :: kt     ! Main time step counter 
     43      !! 
     44      INTEGER               :: ib_bdy ! Loop index 
     45 
     46      DO ib_bdy=1, nb_bdy 
     47 
     48         SELECT CASE( nn_tra(ib_bdy) ) 
     49         CASE(jp_none) 
     50            CYCLE 
     51         CASE(jp_frs) 
     52            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     53         CASE DEFAULT 
     54            CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     55         END SELECT 
     56      ENDDO 
     57 
     58   END SUBROUTINE bdy_tra 
     59 
     60   SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
    3461      !!---------------------------------------------------------------------- 
    3562      !!                 ***  SUBROUTINE bdy_tra_frs  *** 
    3663      !!                     
    37       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers in the   
    38       !!              case of unstructured open boundaries. 
     64      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    3965      !!  
    4066      !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    4167      !!---------------------------------------------------------------------- 
    42       INTEGER, INTENT( in ) ::   kt 
     68      INTEGER,         INTENT(in) ::   kt 
     69      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
     70      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    4371      !!  
    4472      REAL(wp) ::   zwgt           ! boundary weight 
    … …  
    4775      !!---------------------------------------------------------------------- 
    4876      ! 
    49       IF(ln_tra_frs) THEN       ! If this is false, then this routine does nothing.  
    50          ! 
    51          IF( kt == nit000 ) THEN 
    52             IF(lwp) WRITE(numout,*) 
    53             IF(lwp) WRITE(numout,*) 'bdy_tra_frs : Flow Relaxation Scheme for tracers' 
    54             IF(lwp) WRITE(numout,*) '~~~~~~~' 
    55          ENDIF 
    56          ! 
    57          igrd = 1                       ! Everything is at T-points here 
    58          DO ib = 1, nblen(igrd) 
    59             DO ik = 1, jpkm1 
    60                ii = nbi(ib,igrd) 
    61                ij = nbj(ib,igrd) 
    62                zwgt = nbw(ib,igrd) 
    63                tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)          
    64                tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 
    65             END DO 
    66          END DO  
    67          !                                              ! Boundary points should be updated 
    68          CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      
    69          CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )     
    70          ! 
    71       ENDIF ! ln_tra_frs 
    7277      ! 
     78      igrd = 1                       ! Everything is at T-points here 
     79      DO ib = 1, idx%nblen(igrd) 
     80         DO ik = 1, jpkm1 
     81            ii = idx%nbi(ib,igrd) 
     82            ij = idx%nbj(ib,igrd) 
     83            zwgt = idx%nbw(ib,igrd) 
     84            tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik)          
     85            tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik) 
     86         END DO 
     87      END DO  
     88      ! 
     89      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )    ! Boundary points should be updated 
     90      ! 
     91      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
     92   ! 
    7393   END SUBROUTINE bdy_tra_frs 
    7494    
    … …  
    7898   !!---------------------------------------------------------------------- 
    7999CONTAINS 
    80    SUBROUTINE bdy_tra_frs(kt)      ! Empty routine 
    81       WRITE(*,*) 'bdy_tra_frs: You should not have seen this print! error?', kt 
    82    END SUBROUTINE bdy_tra_frs 
     100   SUBROUTINE bdy_tra(kt)      ! Empty routine 
     101      WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt 
     102   END SUBROUTINE bdy_tra 
    83103#endif 
    84104 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r2528 r3116  
    7171      !! 
    7272      INTEGER  ::   ji, jj, jk, jb, jgrd 
    73       INTEGER  ::   ii, ij 
     73      INTEGER  ::   ib_bdy, ii, ij 
    7474      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst 
     75      TYPE(OBC_INDEX), POINTER :: idx 
    7576      !!----------------------------------------------------------------------------- 
    7677 
    … …  
    9192      ! ------------------------------------------------ 
    9293      zubtpecor = 0.e0 
    93       jgrd = 2                               ! cumulate u component contribution first  
    94       DO jb = 1, nblenrim(jgrd) 
    95          DO jk = 1, jpkm1 
    96             ii = nbi(jb,jgrd) 
    97             ij = nbj(jb,jgrd) 
    98             zubtpecor = zubtpecor + flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     94      DO ib_bdy = 1, nb_bdy 
     95         idx => idx_bdy(ib_bdy) 
     96 
     97         jgrd = 2                               ! cumulate u component contribution first  
     98         DO jb = 1, idx%nblenrim(jgrd) 
     99            DO jk = 1, jpkm1 
     100               ii = idx%nbi(jb,jgrd) 
     101               ij = idx%nbj(jb,jgrd) 
     102               zubtpecor = zubtpecor + idx%flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     103            END DO 
    99104         END DO 
    100       END DO 
    101       jgrd = 3                               ! then add v component contribution 
    102       DO jb = 1, nblenrim(jgrd) 
    103          DO jk = 1, jpkm1 
    104             ii = nbi(jb,jgrd) 
    105             ij = nbj(jb,jgrd) 
    106             zubtpecor = zubtpecor + flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
     105         jgrd = 3                               ! then add v component contribution 
     106         DO jb = 1, idx%nblenrim(jgrd) 
     107            DO jk = 1, jpkm1 
     108               ii = idx%nbi(jb,jgrd) 
     109               ij = idx%nbj(jb,jgrd) 
     110               zubtpecor = zubtpecor + idx%flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
     111            END DO 
    107112         END DO 
     113 
    108114      END DO 
    109115      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain 
    … …  
    118124      ! ------------------------------------------------------------- 
    119125      ztranst = 0.e0 
    120       jgrd = 2                               ! correct u component 
    121       DO jb = 1, nblenrim(jgrd) 
    122          DO jk = 1, jpkm1 
    123             ii = nbi(jb,jgrd) 
    124             ij = nbj(jb,jgrd) 
    125             ua(ii,ij,jk) = ua(ii,ij,jk) - flagu(jb) * zubtpecor * umask(ii,ij,jk) 
    126             ztranst = ztranst + flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     126      DO ib_bdy = 1, nb_bdy 
     127         idx => idx_bdy(ib_bdy) 
     128 
     129         jgrd = 2                               ! correct u component 
     130         DO jb = 1, idx%nblenrim(jgrd) 
     131            DO jk = 1, jpkm1 
     132               ii = idx%nbi(jb,jgrd) 
     133               ij = idx%nbj(jb,jgrd) 
     134               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb) * zubtpecor * umask(ii,ij,jk) 
     135               ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     136            END DO 
    127137         END DO 
    128       END DO 
    129       jgrd = 3                              ! correct v component 
    130       DO jb = 1, nblenrim(jgrd) 
    131          DO jk = 1, jpkm1 
    132             ii = nbi(jb,jgrd) 
    133             ij = nbj(jb,jgrd) 
    134             va(ii,ij,jk) = va(ii,ij,jk) -flagv(jb) * zubtpecor * vmask(ii,ij,jk) 
    135             ztranst = ztranst + flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
     138         jgrd = 3                              ! correct v component 
     139         DO jb = 1, idx%nblenrim(jgrd) 
     140            DO jk = 1, jpkm1 
     141               ii = idx%nbi(jb,jgrd) 
     142               ij = idx%nbj(jb,jgrd) 
     143               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb) * zubtpecor * vmask(ii,ij,jk) 
     144               ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
     145            END DO 
    136146         END DO 
     147 
    137148      END DO 
    138149      IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r2977 r3116  
    1818   USE lib_mpp         ! distributed memory computing library 
    1919   USE trabbc          ! bottom boundary condition 
     20   USE obc_par         ! (for lk_obc) 
    2021   USE bdy_par         ! (for lk_bdy) 
    21    USE obc_par         ! (for lk_obc) 
    2222 
    2323   IMPLICIT NONE 
    … …  
    205205      WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    206206      WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file" 
    207       IF( lk_obc .OR. lk_bdy) THEN 
     207      IF( lk_obc .or. lk_bdy ) THEN 
    208208         CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    209209      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2715 r3116  
    150150   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag 
    151151#endif 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
    153    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu   , hv     !: depth at u- and v-points (meters) 
    154    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
     152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu   , hv     !: depth at u- and v-points (meters) 
     154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
    155155 
    156156   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r3097 r3116  
    2525   USE oce             ! ocean dynamics and tracers 
    2626   USE dom_oce         ! ocean space and time domain 
    27    USE obc_oce         ! ocean open boundary conditions 
    2827   USE in_out_manager  ! I/O manager 
    2928   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r2779 r3116  
    2424   PRIVATE 
    2525 
    26    PUBLIC   dom_vvl       ! called by domain.F90 
    27    PUBLIC   dom_vvl_alloc ! called by nemogcm.F90 
    28  
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ee_t, ee_u, ee_v, ee_f   !: ??? 
    30    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut , muu , muv , muf    !: ???  
     26   PUBLIC   dom_vvl         ! called by domain.F90 
     27   PUBLIC   dom_vvl_2       ! called by domain.F90 
     28   PUBLIC   dom_vvl_alloc   ! called by nemogcm.F90 
     29 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut , muu , muv , muf    !: 1/H_0 at t-,u-,v-,f-points  
    3131 
    3232   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:)     ::   r2dt   ! vertical profile time-step, = 2 rdttra  
    … …  
    4949      ! 
    5050      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,     & 
    51          &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,     & 
    5251         &      r2dt        (jpk)                                                             , STAT=dom_vvl_alloc ) 
    5352         ! 
    … …  
    6261      !!                ***  ROUTINE dom_vvl  *** 
    6362      !!                    
    64       !! ** Purpose :  compute coefficients muX at T-U-V-F points to spread 
    65       !!               ssh over the whole water column (scale factors) 
     63      !! ** Purpose :   compute mu coefficients at t-, u-, v- and f-points to  
     64      !!              spread ssh over the whole water column (scale factors) 
     65      !!                set the before and now ssh at u- and v-points  
     66      !!              (also f-point in now case) 
    6667      !!---------------------------------------------------------------------- 
    6768      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3     ! 2D workspace 
     69      USE wrk_nemo, ONLY:   zee_t => wrk_2d_1, zee_u => wrk_2d_2, zee_v => wrk_2d_3, zee_f => wrk_2d_4   ! 2D workspace 
    6970      ! 
    7071      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    71       REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! local scalars 
    72       REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !   -      - 
    73       !!---------------------------------------------------------------------- 
    74  
    75       IF( wrk_in_use(2, 1,2,3) ) THEN 
     72      REAL(wp) ::   zcoefu, zcoefv , zcoeff                ! local scalars 
     73      REAL(wp) ::   zvt   , zvt_ip1, zvt_jp1, zvt_ip1jp1   !   -      - 
     74      !!---------------------------------------------------------------------- 
     75 
     76      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
    7677         CALL ctl_stop('dom_vvl: requested workspace arrays unavailable')   ;   RETURN 
    7778      ENDIF 
    … …  
    9798 
    9899      !                                 !==  mu computation  ==! 
    99       ee_t(:,:) = fse3t_0(:,:,1)                ! Lower bound : thickness of the first model level 
    100       ee_u(:,:) = fse3u_0(:,:,1) 
    101       ee_v(:,:) = fse3v_0(:,:,1) 
    102       ee_f(:,:) = fse3f_0(:,:,1) 
     100      zee_t(:,:) = fse3t_0(:,:,1)                ! Lower bound : thickness of the first model level 
     101      zee_u(:,:) = fse3u_0(:,:,1) 
     102      zee_v(:,:) = fse3v_0(:,:,1) 
     103      zee_f(:,:) = fse3f_0(:,:,1) 
    103104      DO jk = 2, jpkm1                          ! Sum of the masked vertical scale factors 
    104          ee_t(:,:) = ee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk) 
    105          ee_u(:,:) = ee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk) 
    106          ee_v(:,:) = ee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk) 
     105         zee_t(:,:) = zee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk) 
     106         zee_u(:,:) = zee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk) 
     107         zee_v(:,:) = zee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk) 
    107108         DO jj = 1, jpjm1                      ! f-point : fmask=shlat at coasts, use the product of umask 
    108             ee_f(:,jj) = ee_f(:,jj) + fse3f_0(:,jj,jk) *  umask(:,jj,jk) * umask(:,jj+1,jk) 
     109            zee_f(:,jj) = zee_f(:,jj) + fse3f_0(:,jj,jk) *  umask(:,jj,jk) * umask(:,jj+1,jk) 
    109110         END DO 
    110111      END DO   
    111112      !                                         ! Compute and mask the inverse of the local depth at T, U, V and F points 
    112       ee_t(:,:) = 1. / ee_t(:,:) * tmask(:,:,1) 
    113       ee_u(:,:) = 1. / ee_u(:,:) * umask(:,:,1) 
    114       ee_v(:,:) = 1. / ee_v(:,:) * vmask(:,:,1) 
     113      zee_t(:,:) = 1._wp / zee_t(:,:) * tmask(:,:,1) 
     114      zee_u(:,:) = 1._wp / zee_u(:,:) * umask(:,:,1) 
     115      zee_v(:,:) = 1._wp / zee_v(:,:) * vmask(:,:,1) 
    115116      DO jj = 1, jpjm1                               ! f-point case fmask cannot be used  
    116          ee_f(:,jj) = 1. / ee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1) 
    117       END DO 
    118       CALL lbc_lnk( ee_f, 'F', 1. )                  ! lateral boundary condition on ee_f 
     117         zee_f(:,jj) = 1._wp / zee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1) 
     118      END DO 
     119      CALL lbc_lnk( zee_f, 'F', 1. )                 ! lateral boundary condition on ee_f 
    119120      ! 
    120121      DO jk = 1, jpk                            ! mu coefficients 
    121          mut(:,:,jk) = ee_t(:,:) * tmask(:,:,jk)     ! T-point at T levels 
    122          muu(:,:,jk) = ee_u(:,:) * umask(:,:,jk)     ! U-point at T levels 
    123          muv(:,:,jk) = ee_v(:,:) * vmask(:,:,jk)     ! V-point at T levels 
     122         mut(:,:,jk) = zee_t(:,:) * tmask(:,:,jk)     ! T-point at T levels 
     123         muu(:,:,jk) = zee_u(:,:) * umask(:,:,jk)     ! U-point at T levels 
     124         muv(:,:,jk) = zee_v(:,:) * vmask(:,:,jk)     ! V-point at T levels 
    124125      END DO 
    125126      DO jk = 1, jpk                                 ! F-point : fmask=shlat at coasts, use the product of umask 
    126127         DO jj = 1, jpjm1 
    127                muf(:,jj,jk) = ee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk)   ! at T levels 
    128          END DO 
    129          muf(:,jpj,jk) = 0.e0 
     128               muf(:,jj,jk) = zee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk)   ! at T levels 
     129         END DO 
     130         muf(:,jpj,jk) = 0._wp 
    130131      END DO 
    131132      CALL lbc_lnk( muf, 'F', 1. )                   ! lateral boundary condition 
    … …  
    139140      END DO 
    140141       
    141       ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations 
    142       ! for ssh and scale factors 
    143       zs_t  (:,:) =         e1t(:,:) * e2t(:,:) 
    144       zs_u_1(:,:) = 0.5 / ( e1u(:,:) * e2u(:,:) ) 
    145       zs_v_1(:,:) = 0.5 / ( e1v(:,:) * e2v(:,:) ) 
    146  
    147142      DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points 
    148143         DO ji = 1, jpim1   ! NO vector opt. 
    149             zcoefu = umask(ji,jj,1) * zs_u_1(ji,jj) 
    150             zcoefv = vmask(ji,jj,1) * zs_v_1(ji,jj) 
    151             zcoeff = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    152             ! before fields 
    153             zv_t_ij       = zs_t(ji  ,jj  ) * sshb(ji  ,jj  ) 
    154             zv_t_ip1j     = zs_t(ji+1,jj  ) * sshb(ji+1,jj  ) 
    155             zv_t_ijp1     = zs_t(ji  ,jj+1) * sshb(ji  ,jj+1) 
    156             sshu_b(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j ) 
    157             sshv_b(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 ) 
    158             ! now fields 
    159             zv_t_ij       = zs_t(ji  ,jj  ) * sshn(ji  ,jj  ) 
    160             zv_t_ip1j     = zs_t(ji+1,jj  ) * sshn(ji+1,jj  ) 
    161             zv_t_ijp1     = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1) 
    162             zv_t_ip1jp1   = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1) 
    163             sshu_n(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j ) 
    164             sshv_n(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 ) 
    165             sshf_n(ji,jj) = zcoeff * ( zv_t_ij + zv_t_ip1j + zv_t_ijp1 + zv_t_ip1jp1 ) 
     144            zcoefu = 0.50_wp / ( e1u(ji,jj) * e2u(ji,jj) ) * umask(ji,jj,1) 
     145            zcoefv = 0.50_wp / ( e1v(ji,jj) * e2v(ji,jj) ) * vmask(ji,jj,1) 
     146            zcoeff = 0.25_wp / ( e1f(ji,jj) * e2f(ji,jj) ) * umask(ji,jj,1) * umask(ji,jj+1,1) 
     147            ! 
     148            zvt           = e1e2t(ji  ,jj  ) * sshb(ji  ,jj  )    ! before fields 
     149            zvt_ip1       = e1e2t(ji+1,jj  ) * sshb(ji+1,jj  ) 
     150            zvt_jp1       = e1e2t(ji  ,jj+1) * sshb(ji  ,jj+1) 
     151            sshu_b(ji,jj) = zcoefu * ( zvt + zvt_ip1 ) 
     152            sshv_b(ji,jj) = zcoefv * ( zvt + zvt_jp1 ) 
     153            ! 
     154            zvt           = e1e2t(ji  ,jj  ) * sshn(ji  ,jj  )    ! now fields 
     155            zvt_ip1       = e1e2t(ji+1,jj  ) * sshn(ji+1,jj  ) 
     156            zvt_jp1       = e1e2t(ji  ,jj+1) * sshn(ji  ,jj+1) 
     157            zvt_ip1jp1    = e1e2t(ji+1,jj+1) * sshn(ji+1,jj+1) 
     158            sshu_n(ji,jj) = zcoefu * ( zvt + zvt_ip1 ) 
     159            sshv_n(ji,jj) = zcoefv * ( zvt + zvt_jp1 ) 
     160            sshf_n(ji,jj) = zcoeff * ( zvt + zvt_ip1 + zvt_jp1 + zvt_ip1jp1 ) 
    166161         END DO 
    167162      END DO 
    … …  
    169164      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. ) 
    170165      CALL lbc_lnk( sshf_n, 'F', 1. ) 
    171  
    172                                                 ! initialise before scale factors at (u/v)-points 
    173       ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
    174       DO jk = 1, jpkm1 
    175          DO jj = 1, jpjm1 
    176             DO ji = 1, jpim1 
    177                zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
    178                zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
    179                zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
    180                fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 
    181                fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 
    182             END DO 
    183          END DO 
    184       END DO 
    185       CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions 
    186       CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 
    187       ! Add initial scale factor to scale factor anomaly 
    188       fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 
    189       fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
    190       ! 
    191       IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dom_vvl: failed to release workspace arrays') 
     166      ! 
     167      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('dom_vvl: failed to release workspace arrays') 
    192168      ! 
    193169   END SUBROUTINE dom_vvl 
    194170 
     171 
     172   SUBROUTINE dom_vvl_2( kt, pe3u_b, pe3v_b ) 
     173      !!---------------------------------------------------------------------- 
     174      !!                ***  ROUTINE dom_vvl_2  *** 
     175      !!                    
     176      !! ** Purpose :   compute the vertical scale factors at u- and v-points 
     177      !!              in variable volume case. 
     178      !! 
     179      !! ** Method  :   In variable volume case (non linear sea surface) the  
     180      !!              the vertical scale factor at velocity points is computed 
     181      !!              as the average of the cell surface weighted e3t. 
     182      !!                It uses the sea surface heigth so it have to be initialized 
     183      !!              after ssh is read/set 
     184      !!---------------------------------------------------------------------- 
     185      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index 
     186      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe3u_b, pe3v_b   ! before vertical scale factor at u- & v-pts 
     187      ! 
     188      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     189      INTEGER  ::   iku, ikv     ! local integers     
     190      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers 
     191      REAL(wp) ::   zvt          ! local scalars 
     192      !!---------------------------------------------------------------------- 
     193 
     194      IF( lwp .AND. kt == nit000 ) THEN 
     195         WRITE(numout,*) 
     196         WRITE(numout,*) 'dom_vvl_2 : Variable volume, fse3t_b initialization' 
     197         WRITE(numout,*) '~~~~~~~~~ ' 
     198         pe3u_b(:,:,jpk) = fse3u_0(:,:,jpk) 
     199         pe3v_b(:,:,jpk) = fse3u_0(:,:,jpk) 
     200      ENDIF 
     201       
     202      DO jk = 1, jpkm1           ! set the before scale factors at u- & v-points 
     203         DO jj = 2, jpjm1 
     204            DO ji = fs_2, fs_jpim1 
     205               zvt = fse3t_b(ji,jj,jk) * e1e2t(ji,jj) 
     206               pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1e2t(ji+1,jj) ) / ( e1u(ji,jj) * e2u(ji,jj) ) 
     207               pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e1e2t(ji,jj+1) ) / ( e1v(ji,jj) * e2v(ji,jj) ) 
     208            END DO 
     209         END DO 
     210      END DO 
     211 
     212      ! Correct scale factors at locations that have been individually modified in domhgr 
     213      ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute 
     214      ! scale factors ignoring the modified metric. 
     215      !                                                ! ===================== 
     216      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     217         !                                             ! ===================== 
     218         IF( nn_cla == 0 ) THEN 
     219            ! 
     220            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified) 
     221            ij0 = 102   ;   ij1 = 102    
     222            DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     223               DO jj = mj0(ij0), mj1(ij1) 
     224                  DO ji = mi0(ii0), mi1(ii1) 
     225                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     226                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     227                  END DO 
     228               END DO 
     229            END DO 
     230            ! 
     231            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified) 
     232            ij0 =  88   ;   ij1 =  88    
     233            DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     234               DO jj = mj0(ij0), mj1(ij1) 
     235                  DO ji = mi0(ii0), mi1(ii1) 
     236                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     237                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     238                  END DO 
     239               END DO 
     240            END DO 
     241            DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     242               DO jj = mj0(ij0), mj1(ij1) 
     243                  DO ji = mi0(ii0), mi1(ii1) 
     244                     zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     245                     pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     246                  END DO 
     247               END DO 
     248            END DO 
     249         ENDIF 
     250 
     251         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified) 
     252         ij0 = 116   ;   ij1 = 116    
     253         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     254            DO jj = mj0(ij0), mj1(ij1) 
     255               DO ji = mi0(ii0), mi1(ii1) 
     256                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     257                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     258               END DO 
     259            END DO 
     260         END DO 
     261         ! 
     262      ENDIF 
     263         !                                             ! ===================== 
     264      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
     265         !                                             ! ===================== 
     266 
     267         ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified) 
     268         ij0 = 200   ;   ij1 = 200    
     269         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     270            DO jj = mj0(ij0), mj1(ij1) 
     271               DO ji = mi0(ii0), mi1(ii1) 
     272                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     273                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     274               END DO 
     275            END DO 
     276         END DO 
     277 
     278         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified) 
     279         ij0 = 208   ;   ij1 = 208    
     280         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     281            DO jj = mj0(ij0), mj1(ij1) 
     282               DO ji = mi0(ii0), mi1(ii1) 
     283                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     284                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     285               END DO 
     286            END DO 
     287         END DO 
     288 
     289         ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified) 
     290         ij0 = 124   ;   ij1 = 125    
     291         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     292            DO jj = mj0(ij0), mj1(ij1) 
     293               DO ji = mi0(ii0), mi1(ii1) 
     294                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     295                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     296               END DO 
     297            END DO 
     298         END DO 
     299 
     300         ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 
     301         ij0 = 124   ;   ij1 = 125    
     302         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     303            DO jj = mj0(ij0), mj1(ij1) 
     304               DO ji = mi0(ii0), mi1(ii1) 
     305                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     306                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     307               END DO 
     308            END DO 
     309         END DO 
     310 
     311         ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified) 
     312         ij0 = 124   ;   ij1 = 125    
     313         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     314            DO jj = mj0(ij0), mj1(ij1) 
     315               DO ji = mi0(ii0), mi1(ii1) 
     316                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     317                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     318               END DO 
     319            END DO 
     320         END DO 
     321 
     322         ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified) 
     323         ij0 = 124   ;   ij1 = 125    
     324         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     325            DO jj = mj0(ij0), mj1(ij1) 
     326               DO ji = mi0(ii0), mi1(ii1) 
     327                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     328                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     329               END DO 
     330            END DO 
     331         END DO 
     332 
     333         ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
     334         ij0 = 141   ;   ij1 = 142    
     335         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     336            DO jj = mj0(ij0), mj1(ij1) 
     337               DO ji = mi0(ii0), mi1(ii1) 
     338                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     339                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     340               END DO 
     341            END DO 
     342         END DO 
     343 
     344         ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
     345         ij0 = 141   ;   ij1 = 142    
     346         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     347            DO jj = mj0(ij0), mj1(ij1) 
     348               DO ji = mi0(ii0), mi1(ii1) 
     349                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     350                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     351               END DO 
     352            END DO 
     353         END DO 
     354 
     355         ! 
     356      ENDIF 
     357      !                                                ! ====================== 
     358      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration 
     359         !                                             ! ====================== 
     360         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified) 
     361         ij0 = 327   ;   ij1 = 327    
     362         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     363            DO jj = mj0(ij0), mj1(ij1) 
     364               DO ji = mi0(ii0), mi1(ii1) 
     365                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     366                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     367               END DO 
     368            END DO 
     369         END DO 
     370         ! 
     371         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u was modified) 
     372         ij0 = 343   ;   ij1 = 343    
     373         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     374            DO jj = mj0(ij0), mj1(ij1) 
     375               DO ji = mi0(ii0), mi1(ii1) 
     376                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     377                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     378               END DO 
     379            END DO 
     380         END DO 
     381         ! 
     382         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified) 
     383         ij0 = 232   ;   ij1 = 232    
     384         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     385            DO jj = mj0(ij0), mj1(ij1) 
     386               DO ji = mi0(ii0), mi1(ii1) 
     387                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     388                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     389               END DO 
     390            END DO 
     391         END DO 
     392         ! 
     393         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified) 
     394         ij0 = 232   ;   ij1 = 232    
     395         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     396            DO jj = mj0(ij0), mj1(ij1) 
     397               DO ji = mi0(ii0), mi1(ii1) 
     398                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     399                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     400               END DO 
     401            END DO 
     402         END DO 
     403         ! 
     404         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified) 
     405         ij0 = 270   ;   ij1 = 270    
     406         DO jk = 1, jpkm1                 ! set the before scale factors at u-points 
     407            DO jj = mj0(ij0), mj1(ij1) 
     408               DO ji = mi0(ii0), mi1(ii1) 
     409                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 
     410                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 
     411               END DO 
     412            END DO 
     413         END DO 
     414         ! 
     415         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified) 
     416         ij0 = 232   ;   ij1 = 233    
     417         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     418            DO jj = mj0(ij0), mj1(ij1) 
     419               DO ji = mi0(ii0), mi1(ii1) 
     420                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     421                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     422               END DO 
     423            END DO 
     424         END DO 
     425         ! 
     426         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified) 
     427         ij0 = 276   ;   ij1 = 276    
     428         DO jk = 1, jpkm1                 ! set the before scale factors at v-points 
     429            DO jj = mj0(ij0), mj1(ij1) 
     430               DO ji = mi0(ii0), mi1(ii1) 
     431                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 
     432                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 
     433               END DO 
     434            END DO 
     435         END DO 
     436         ! 
     437      ENDIF 
     438      ! End of individual corrections to scale factors 
     439 
     440      IF( ln_zps ) THEN          ! minimum of the e3t at partial cell level 
     441         DO jj = 2, jpjm1 
     442            DO ji = fs_2, fs_jpim1 
     443               iku = mbku(ji,jj) 
     444               ikv = mbkv(ji,jj) 
     445               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) )  
     446               pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji  ,jj+1,ikv) )  
     447            END DO 
     448         END DO 
     449      ENDIF 
     450 
     451      pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:)      ! anomaly to avoid zero along closed boundary/extra halos 
     452      pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:) 
     453      CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions 
     454      CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. ) 
     455      pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:)      ! recover the full scale factor 
     456      pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:) 
     457      ! 
     458   END SUBROUTINE dom_vvl_2 
     459    
    195460#else 
    196461   !!---------------------------------------------------------------------- 
    … …  
    200465   SUBROUTINE dom_vvl 
    201466   END SUBROUTINE dom_vvl 
     467   SUBROUTINE dom_vvl_2(kdum, pudum, pvdum ) 
     468      USE par_kind 
     469      INTEGER                   , INTENT(in   ) ::   kdum        
     470      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pudum, pvdum 
     471   END SUBROUTINE dom_vvl_2 
    202472#endif 
    203473 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2715 r3116  
    14951495      ! 
    14961496!!    H. Liu, POL. April 2009. Added for passing the scale check for the new released vvl code. 
     1497      where (e3t   (:,:,:).eq.0.0)  e3t(:,:,:) = 1.0 
     1498      where (e3u   (:,:,:).eq.0.0)  e3u(:,:,:) = 1.0 
     1499      where (e3v   (:,:,:).eq.0.0)  e3v(:,:,:) = 1.0 
     1500      where (e3f   (:,:,:).eq.0.0)  e3f(:,:,:) = 1.0 
     1501      where (e3w   (:,:,:).eq.0.0)  e3w(:,:,:) = 1.0 
     1502      where (e3uw  (:,:,:).eq.0.0)  e3uw(:,:,:) = 1.0 
     1503      where (e3vw  (:,:,:).eq.0.0)  e3vw(:,:,:) = 1.0 
     1504 
    14971505 
    14981506      fsdept(:,:,:) = gdept (:,:,:) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r2977 r3116  
    8383         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog) 
    8484         CALL rst_read                           ! Read the restart file 
     85         !                                       ! define e3u_b, e3v_b from e3t_b read in restart file 
     86         CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 
    8587         CALL day_init                           ! model calendar (using both namelist and restart infos) 
    8688      ELSE 
    … …  
    9193         CALL day_init                           ! model calendar (using both namelist and restart infos) 
    9294         !                                       ! Initialization of ocean to zero 
    93          !   before fields     !       now fields      
    94          sshb (:,:)   = 0.e0   ;   sshn (:,:)   = 0.e0 
    95          ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0 
    96          vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0   
    97          rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0 
    98          hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0 
     95         !   before fields      !       now fields      
     96         sshb (:,:)   = 0._wp   ;   sshn (:,:)   = 0._wp 
     97         ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp 
     98         vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp   
     99         rotb (:,:,:) = 0._wp   ;   rotn (:,:,:) = 0._wp 
     100         hdivb(:,:,:) = 0._wp   ;   hdivn(:,:,:) = 0._wp 
    99101         ! 
    100          IF( cp_cfg == 'eel'      ) THEN 
     102         !                                       ! define e3u_b, e3v_b from e3t_b initialized in domzgr 
     103         CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 
     104         ! 
     105         IF( cp_cfg == 'eel' ) THEN 
    101106            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields 
    102107         ELSEIF( cp_cfg == 'gyre' ) THEN          

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r2528 r3116  
    99   !!              -   !  2006-08  (G. Madec)  style  
    1010   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style  
     11   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants  
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    4849#endif 
    4950 
     51#if defined key_cice 
     52   REAL(wp), PUBLIC ::   rau0     = 1026._wp      !: reference volumic mass (density)  (kg/m3) 
     53#else 
    5054   REAL(wp), PUBLIC ::   rau0     = 1035._wp      !: reference volumic mass (density)  (kg/m3) 
     55#endif 
    5156   REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg) 
    5257   REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat 
    5358   REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp ) 
    5459 
    55 #if defined key_lim3 
     60#if defined key_lim3 || defined key_cice 
    5661   REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow 
    5762   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice 
    … …  
    100105      rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
    101106      rsiday = rday / ( 1. + rday / rsiyea ) 
     107#if defined key_cice 
     108      omega =  7.292116e-05 
     109#else 
    102110      omega  = 2. * rpi / rsiday  
     111#endif 
    103112 
    104113      rau0r  = 1. /   rau0   
    … …  
    155164         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    156165         WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
     166#elif defined key_cice 
     167         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    157168#else 
    158169         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2715 r3116  
    2727   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
    2828   USE sbcrnf          ! river runoff  
    29    USE obc_oce         ! ocean lateral open boundary condition 
    3029   USE cla             ! cross land advection             (cla_div routine) 
    3130   USE in_out_manager  ! I/O manager 
    … …  
    121120         END DO 
    122121 
    123 #if defined key_obc 
    124          IF( Agrif_Root() ) THEN 
    125             ! open boundaries (div must be zero behind the open boundary) 
    126             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    127             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    128             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    129             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    130             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    131          ENDIF 
    132 #endif          
    133122         IF( .NOT. AGRIF_Root() ) THEN 
    134123            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    … …  
    304293         END DO   
    305294 
    306 #if defined key_obc 
    307          IF( Agrif_Root() ) THEN 
    308             ! open boundaries (div must be zero behind the open boundary) 
    309             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    310             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    311             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    312             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    313             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    314          ENDIF 
    315 #endif          
    316295         IF( .NOT. AGRIF_Root() ) THEN 
    317296            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r2715 r3116  
    1313   USE dom_oce         ! ocean space and time domain variables  
    1414   USE zdf_oce         ! ocean vertical physics variables 
     15   USE zdfbfr          ! ocean bottom friction variables 
    1516   USE trdmod          ! ocean active dynamics and tracers trends  
    1617   USE trdmod_oce      ! ocean variables trends 
    … …  
    5152      !!--------------------------------------------------------------------- 
    5253      ! 
    53       zm1_2dt = - 1._wp / ( 2._wp * rdt ) 
     54      IF( .not. ln_bfrimp) THEN     ! only for explicit bottom friction form 
     55                                    ! implicit bfr is implemented in dynzdf_imp 
     56                                    ! H. Liu,  Sept. 2011 
    5457 
    55       IF( l_trddyn )   THEN                      ! temporary save of ua and va trends 
    56          ztrduv(:,:,:,1) = ua(:,:,:) 
    57          ztrduv(:,:,:,2) = va(:,:,:) 
    58       ENDIF 
     58        zm1_2dt = - 1._wp / ( 2._wp * rdt ) 
     59 
     60        IF( l_trddyn )   THEN                      ! temporary save of ua and va trends 
     61           ztrduv(:,:,:,1) = ua(:,:,:) 
     62           ztrduv(:,:,:,2) = va(:,:,:) 
     63        ENDIF 
     64 
    5965 
    6066# if defined key_vectopt_loop 
    61       DO jj = 1, 1 
    62          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     67        DO jj = 1, 1 
     68           DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    6369# else 
    64       DO jj = 2, jpjm1 
    65          DO ji = 2, jpim1 
     70        DO jj = 2, jpjm1 
     71           DO ji = 2, jpim1 
    6672# endif 
    67             ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    68             ikbv = mbkv(ji,jj) 
    69             ! 
    70             ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    71             ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) 
    72             va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) 
    73          END DO 
    74       END DO 
     73              ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
     74              ikbv = mbkv(ji,jj) 
     75              ! 
     76              ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
     77              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) 
     78              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) 
     79           END DO 
     80        END DO 
    7581 
    76       ! 
    77       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    78          ztrduv(:,:,:,1) = ua(:,:,:) - ztrduv(:,:,:,1) 
    79          ztrduv(:,:,:,2) = va(:,:,:) - ztrduv(:,:,:,2) 
    80          CALL trd_mod( ztrduv(:,:,:,1), ztrduv(:,:,:,2), jpdyn_trd_bfr, 'DYN', kt ) 
    81       ENDIF 
    82       !                                          ! print mean trends (used for debugging) 
    83       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr  - Ua: ', mask1=umask,               & 
    84          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    85       ! 
     82        ! 
     83        IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     84           ztrduv(:,:,:,1) = ua(:,:,:) - ztrduv(:,:,:,1) 
     85           ztrduv(:,:,:,2) = va(:,:,:) - ztrduv(:,:,:,2) 
     86           CALL trd_mod( ztrduv(:,:,:,1), ztrduv(:,:,:,2), jpdyn_trd_bfr, 'DYN', kt ) 
     87        ENDIF 
     88        !                                          ! print mean trends (used for debugging) 
     89        IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr  - Ua: ', mask1=umask,               & 
     90           &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     91        ! 
     92      ENDIF     ! end explicit bottom friction 
    8693   END SUBROUTINE dyn_bfr 
    8794 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2977 r3116  
    1414   !!             -   !  2005-11  (G. Madec) style & small optimisation 
    1515   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     16   !!            3.4  !  2011-11  (A. Coward, H. Liu) introduction of prj scheme;  
     17   !!                 !           suppression of hel, wdj and rot options 
    1618   !!---------------------------------------------------------------------- 
    1719 
    … …  
    2325   !!       hpg_zps  : z-coordinate plus partial steps (interpolation) 
    2426   !!       hpg_sco  : s-coordinate (standard jacobian formulation) 
    25    !!       hpg_hel  : s-coordinate (helsinki modification) 
    26    !!       hpg_wdj  : s-coordinate (weighted density jacobian) 
    2727   !!       hpg_djc  : s-coordinate (Density Jacobian with Cubic polynomial) 
    28    !!       hpg_rot  : s-coordinate (ROTated axes scheme) 
     28   !!       hpg_prj  : s-coordinate (Pressure Jacobian with Cubic polynomial) 
    2929   !!---------------------------------------------------------------------- 
    3030   USE oce             ! ocean dynamics and tracers 
    … …  
    4848   LOGICAL , PUBLIC ::   ln_hpg_zps    = .FALSE.   !: z-coordinate - partial steps (interpolation) 
    4949   LOGICAL , PUBLIC ::   ln_hpg_sco    = .FALSE.   !: s-coordinate (standard jacobian formulation) 
    50    LOGICAL , PUBLIC ::   ln_hpg_hel    = .FALSE.   !: s-coordinate (helsinki modification) 
    51    LOGICAL , PUBLIC ::   ln_hpg_wdj    = .FALSE.   !: s-coordinate (weighted density jacobian) 
    5250   LOGICAL , PUBLIC ::   ln_hpg_djc    = .FALSE.   !: s-coordinate (Density Jacobian with Cubic polynomial) 
    53    LOGICAL , PUBLIC ::   ln_hpg_rot    = .FALSE.   !: s-coordinate (ROTated axes scheme) 
    54    REAL(wp), PUBLIC ::   rn_gamma      = 0._wp     !: weighting coefficient 
     51   LOGICAL , PUBLIC ::   ln_hpg_prj    = .FALSE.   !: s-coordinate (Pressure Jacobian scheme) 
    5552   LOGICAL , PUBLIC ::   ln_dynhpg_imp = .FALSE.   !: semi-implicite hpg flag 
    5653 
    57    INTEGER  ::   nhpg  =  0   ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 
     54   INTEGER  ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 
    5855 
    5956   !! * Substitutions 
    … …  
    9188      ENDIF       
    9289      ! 
    93       SELECT CASE ( nhpg )      ! Hydrastatic pressure gradient computation 
     90      SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation 
    9491      CASE (  0 )   ;   CALL hpg_zco    ( kt )      ! z-coordinate 
    9592      CASE (  1 )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation) 
    9693      CASE (  2 )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation) 
    97       CASE (  3 )   ;   CALL hpg_hel    ( kt )      ! s-coordinate (helsinki modification) 
    98       CASE (  4 )   ;   CALL hpg_wdj    ( kt )      ! s-coordinate (weighted density jacobian) 
    99       CASE (  5 )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial) 
    100       CASE (  6 )   ;   CALL hpg_rot    ( kt )      ! s-coordinate (ROTated axes scheme) 
     94      CASE (  3 )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial) 
     95      CASE (  4 )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme) 
    10196      END SELECT 
    10297      ! 
    … …  
    125120      INTEGER ::   ioptio = 0      ! temporary integer 
    126121      !! 
    127       NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, ln_hpg_hel,    & 
    128          &                 ln_hpg_wdj, ln_hpg_djc, ln_hpg_rot, rn_gamma  , ln_dynhpg_imp 
     122      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     & 
     123         &                 ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp 
    129124      !!---------------------------------------------------------------------- 
    130125      ! 
    … …  
    140135         WRITE(numout,*) '      z-coord. - partial steps (interpolation)          ln_hpg_zps    = ', ln_hpg_zps 
    141136         WRITE(numout,*) '      s-coord. (standard jacobian formulation)          ln_hpg_sco    = ', ln_hpg_sco 
    142          WRITE(numout,*) '      s-coord. (helsinki modification)                  ln_hpg_hel    = ', ln_hpg_hel 
    143          WRITE(numout,*) '      s-coord. (weighted density jacobian)              ln_hpg_wdj    = ', ln_hpg_wdj 
    144137         WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc 
    145          WRITE(numout,*) '      s-coord. (ROTated axes scheme)                    ln_hpg_rot    = ', ln_hpg_rot 
    146          WRITE(numout,*) '      weighting coeff. (wdj scheme)                     rn_gamma      = ', rn_gamma 
     138         WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj 
    147139         WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp 
    148140      ENDIF 
    149141      ! 
    150       IF( lk_vvl .AND. .NOT. ln_hpg_sco )   & 
    151          &   CALL ctl_stop('dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco') 
     142      IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj) )   & 
     143         &   CALL ctl_stop('dyn_hpg_init : variable volume key_vvl requires:& 
     144                           & the standard jacobian formulation hpg_sco or & 
     145                           & the pressure jacobian formulation hpg_prj') 
    152146      ! 
    153147      !                               ! Set nhpg from ln_hpg_... flags 
    … …  
    155149      IF( ln_hpg_zps )   nhpg = 1 
    156150      IF( ln_hpg_sco )   nhpg = 2 
    157       IF( ln_hpg_hel )   nhpg = 3 
    158       IF( ln_hpg_wdj )   nhpg = 4 
    159       IF( ln_hpg_djc )   nhpg = 5 
    160       IF( ln_hpg_rot )   nhpg = 6 
    161       ! 
    162       !                               ! Consitency check 
     151      IF( ln_hpg_djc )   nhpg = 3 
     152      IF( ln_hpg_prj )   nhpg = 4 
     153      ! 
     154      !                               ! Consistency check 
    163155      ioptio = 0  
    164156      IF( ln_hpg_zco )   ioptio = ioptio + 1 
    165157      IF( ln_hpg_zps )   ioptio = ioptio + 1 
    166158      IF( ln_hpg_sco )   ioptio = ioptio + 1 
    167       IF( ln_hpg_hel )   ioptio = ioptio + 1 
    168       IF( ln_hpg_wdj )   ioptio = ioptio + 1 
    169159      IF( ln_hpg_djc )   ioptio = ioptio + 1 
    170       IF( ln_hpg_rot )   ioptio = ioptio + 1 
     160      IF( ln_hpg_prj )   ioptio = ioptio + 1 
    171161      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 
    172162      ! 
    … …  
    433423   END SUBROUTINE hpg_sco 
    434424 
    435  
    436    SUBROUTINE hpg_hel( kt ) 
    437       !!--------------------------------------------------------------------- 
    438       !!                  ***  ROUTINE hpg_hel  *** 
    439       !! 
    440       !! ** Method  :   s-coordinate case. 
    441       !!      The now hydrostatic pressure gradient at a given level 
    442       !!      jk is computed by taking the vertical integral of the in-situ  
    443       !!      density gradient along the model level from the suface to that  
    444       !!      level. s-coordinates (ln_sco): a corrective term is added 
    445       !!      to the horizontal pressure gradient : 
    446       !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ] 
    447       !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ] 
    448       !!      add it to the general momentum trend (ua,va). 
    449       !!         ua = ua - 1/e1u * zhpi 
    450       !!         va = va - 1/e2v * zhpj 
    451       !! 
    452       !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    453       !!             - Save the trend (l_trddyn=T) 
    454       !!---------------------------------------------------------------------- 
    455       USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    456       !! 
    457       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    458       !! 
    459       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    460       REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    461       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    462       !!---------------------------------------------------------------------- 
    463  
    464       zhpi => tsa(:,:,:,1)  
    465       zhpj => tsa(:,:,:,2)  
    466       ! 
    467       IF( kt == nit000 ) THEN 
    468          IF(lwp) WRITE(numout,*) 
    469          IF(lwp) WRITE(numout,*) 'dyn:hpg_hel : hydrostatic pressure gradient trend' 
    470          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, helsinki modified scheme' 
    471       ENDIF 
    472  
    473       ! Local constant initialization 
    474       zcoef0 = - grav * 0.5_wp 
    475   
    476       ! Surface value 
    477       DO jj = 2, jpjm1 
    478          DO ji = fs_2, fs_jpim1   ! vector opt. 
    479             ! hydrostatic pressure gradient along s-surfaces 
    480             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj  ,1) * rhd(ji+1,jj  ,1)  & 
    481                &                                  - fse3t(ji  ,jj  ,1) * rhd(ji  ,jj  ,1) ) 
    482             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3t(ji  ,jj+1,1) * rhd(ji  ,jj+1,1)  & 
    483                &                                  - fse3t(ji  ,jj  ,1) * rhd(ji  ,jj  ,1) ) 
    484             ! s-coordinate pressure gradient correction 
    485             zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) )   & 
    486                &           * ( fsdept(ji+1,jj,1) - fsdept(ji,jj,1) ) / e1u(ji,jj) 
    487             zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) )   & 
    488                &           * ( fsdept(ji,jj+1,1) - fsdept(ji,jj,1) ) / e2v(ji,jj) 
    489             ! add to the general momentum trend 
    490             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    491             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 
    492          END DO 
    493       END DO 
    494       ! 
    495       ! interior value (2=<jk=<jpkm1) 
    496       DO jk = 2, jpkm1 
    497          DO jj = 2, jpjm1 
    498             DO ji = fs_2, fs_jpim1   ! vector opt. 
    499                ! hydrostatic pressure gradient along s-surfaces 
    500                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 
    501                   &           +  zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj,jk  ) * rhd(ji+1,jj,jk)     & 
    502                   &                                     -fse3t(ji  ,jj,jk  ) * rhd(ji  ,jj,jk)   ) & 
    503                   &           +  zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj,jk-1) * rhd(ji+1,jj,jk-1)   & 
    504                   &                                     -fse3t(ji  ,jj,jk-1) * rhd(ji  ,jj,jk-1) ) 
    505                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 
    506                   &           +  zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk  ) * rhd(ji,jj+1,jk)     & 
    507                   &                                     -fse3t(ji,jj  ,jk  ) * rhd(ji,jj,  jk)   ) & 
    508                   &           +  zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk-1) * rhd(ji,jj+1,jk-1)   & 
    509                   &                                     -fse3t(ji,jj  ,jk-1) * rhd(ji,jj,  jk-1) ) 
    510                ! s-coordinate pressure gradient correction 
    511                zuap = - zcoef0 * ( rhd   (ji+1,jj,jk) + rhd   (ji,jj,jk) )   & 
    512                   &            * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
    513                zvap = - zcoef0 * ( rhd   (ji,jj+1,jk) + rhd   (ji,jj,jk) )   & 
    514                   &            * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj) 
    515                ! add to the general momentum trend 
    516                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
    517                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap 
    518             END DO 
    519          END DO 
    520       END DO 
    521       ! 
    522    END SUBROUTINE hpg_hel 
    523  
    524  
    525    SUBROUTINE hpg_wdj( kt ) 
    526       !!--------------------------------------------------------------------- 
    527       !!                  ***  ROUTINE hpg_wdj  *** 
    528       !! 
    529       !! ** Method  :   Weighted Density Jacobian (wdj) scheme (song 1998) 
    530       !!      The weighting coefficients from the namelist parameter rn_gamma 
    531       !!      (alpha=0.5-rn_gamma ; beta=1-alpha=0.5+rn_gamma 
    532       !! 
    533       !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    534       !!---------------------------------------------------------------------- 
    535       USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    536       !! 
    537       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    538       !! 
    539       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    540       REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    541       REAL(wp) ::   zalph , zbeta        !    "         " 
    542       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    543       !!---------------------------------------------------------------------- 
    544       ! 
    545       zhpi => tsa(:,:,:,1)  
    546       zhpj => tsa(:,:,:,2)  
    547       ! 
    548       IF( kt == nit000 ) THEN 
    549          IF(lwp) WRITE(numout,*) 
    550          IF(lwp) WRITE(numout,*) 'dyn:hpg_wdj : hydrostatic pressure gradient trend' 
    551          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   Weighted Density Jacobian' 
    552       ENDIF 
    553  
    554       ! Local constant initialization 
    555       zcoef0 = - grav * 0.5_wp 
    556       zalph  = 0.5_wp - rn_gamma    ! weighting coefficients (alpha=0.5-rn_gamma 
    557       zbeta  = 0.5_wp + rn_gamma    !                        (beta =1-alpha=0.5+rn_gamma 
    558  
    559       ! Surface value (no ponderation) 
    560       DO jj = 2, jpjm1 
    561          DO ji = fs_2, fs_jpim1   ! vector opt. 
    562             ! hydrostatic pressure gradient along s-surfaces 
    563             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * (  fse3w(ji+1,jj  ,1) * rhd(ji+1,jj  ,1)   & 
    564                &                                   - fse3w(ji  ,jj  ,1) * rhd(ji  ,jj  ,1)  ) 
    565             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * (  fse3w(ji  ,jj+1,1) * rhd(ji  ,jj+1,1)   & 
    566                &                                   - fse3w(ji  ,jj  ,1) * rhd(ji,  jj  ,1)  ) 
    567             ! s-coordinate pressure gradient correction 
    568             zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) )   & 
    569                &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj) 
    570             zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) )   & 
    571                &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 
    572             ! add to the general momentum trend 
    573             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    574             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 
    575          END DO 
    576       END DO 
    577  
    578       ! Interior value (2=<jk=<jpkm1) (weighted with zalph & zbeta) 
    579       DO jk = 2, jpkm1 
    580          DO jj = 2, jpjm1 
    581             DO ji = fs_2, fs_jpim1   ! vector opt. 
    582                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)                            & 
    583                   &           * (   (            fsde3w(ji+1,jj,jk  ) + fsde3w(ji,jj,jk  )        & 
    584                   &                            - fsde3w(ji+1,jj,jk-1) - fsde3w(ji,jj,jk-1)    )   & 
    585                   &               * (  zalph * ( rhd   (ji+1,jj,jk-1) - rhd   (ji,jj,jk-1) )      & 
    586                   &                  + zbeta * ( rhd   (ji+1,jj,jk  ) - rhd   (ji,jj,jk  ) )  )   & 
    587                   &             -   (            rhd   (ji+1,jj,jk  ) + rhd   (ji,jj,jk  )        & 
    588                   &                           - rhd   (ji+1,jj,jk-1) - rhd   (ji,jj,jk-1)     )   & 
    589                   &               * (  zalph * ( fsde3w(ji+1,jj,jk-1) - fsde3w(ji,jj,jk-1) )      & 
    590                   &                  + zbeta * ( fsde3w(ji+1,jj,jk  ) - fsde3w(ji,jj,jk  ) )  )  ) 
    591                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)                            & 
    592                   &           * (   (           fsde3w(ji,jj+1,jk  ) + fsde3w(ji,jj,jk  )         & 
    593                   &                           - fsde3w(ji,jj+1,jk-1) - fsde3w(ji,jj,jk-1)     )   & 
    594                   &               * (  zalph * ( rhd   (ji,jj+1,jk-1) - rhd   (ji,jj,jk-1) )      & 
    595                   &                  + zbeta * ( rhd   (ji,jj+1,jk  ) - rhd   (ji,jj,jk  ) )  )   & 
    596                   &             -   (            rhd   (ji,jj+1,jk  ) + rhd   (ji,jj,jk  )        & 
    597                   &                            - rhd   (ji,jj+1,jk-1) - rhd   (ji,jj,jk-1)    )   & 
    598                   &               * (  zalph * ( fsde3w(ji,jj+1,jk-1) - fsde3w(ji,jj,jk-1) )      & 
    599                   &                  + zbeta * ( fsde3w(ji,jj+1,jk  ) - fsde3w(ji,jj,jk  ) )  )  ) 
    600                ! add to the general momentum trend 
    601                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
    602                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) 
    603             END DO 
    604          END DO 
    605       END DO 
    606       ! 
    607    END SUBROUTINE hpg_wdj 
    608  
    609  
    610425   SUBROUTINE hpg_djc( kt ) 
    611426      !!--------------------------------------------------------------------- 
    … …  
    843658 
    844659 
    845    SUBROUTINE hpg_rot( kt ) 
     660   SUBROUTINE hpg_prj( kt ) 
    846661      !!--------------------------------------------------------------------- 
    847       !!                  ***  ROUTINE hpg_rot  *** 
    848       !! 
    849       !! ** Method  :   rotated axes scheme (Thiem and Berntsen 2005) 
    850       !! 
    851       !! Reference: Thiem & Berntsen, Ocean Modelling, In press, 2005. 
    852       !!---------------------------------------------------------------------- 
     662      !!                  ***  ROUTINE hpg_prj  *** 
     663      !! 
     664      !! ** Method  :   s-coordinate case. 
     665      !!      A Pressure-Jacobian horizontal pressure gradient method 
     666      !!      based on the constrained cubic-spline interpolation for 
     667      !!      all vertical coordinate systems 
     668      !! 
     669      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
     670      !!             - Save the trend (l_trddyn=T) 
     671      !! 
     672      !!---------------------------------------------------------------------- 
     673 
    853674      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    854675      USE oce     , ONLY:   tsa                          ! (tsa) used as 2 3D workspace 
    855       USE wrk_nemo, ONLY:   zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
    856       USE wrk_nemo, ONLY:   zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
    857       USE wrk_nemo, ONLY:   zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
    858       USE wrk_nemo, ONLY:   zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
    859       USE wrk_nemo, ONLY:   zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
    860       !! 
    861       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    862       !! 
    863       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    864       REAL(wp) ::   zforg, zcoef0, zuap, zmskd1, zmskd1m   ! temporary scalar 
    865       REAL(wp) ::   zfrot        , zvap, zmskd2, zmskd2m   !    "         " 
    866       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    867       !!---------------------------------------------------------------------- 
    868  
    869       IF( wrk_in_use(2, 1,2,3)             .OR.   & 
    870           wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 
    871          CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable')   ;   RETURN 
     676      USE wrk_nemo, ONLY:   zhpi => wrk_3d_3  
     677      USE wrk_nemo, ONLY:   zu => wrk_3d_4  
     678      USE wrk_nemo, ONLY:   zv => wrk_3d_5 
     679      USE wrk_nemo, ONLY:   sp => wrk_3d_6  
     680      USE wrk_nemo, ONLY:   sp => wrk_3d_7 
     681      USE wrk_nemo, ONLY:   sp => wrk_3d_8 
     682      USE wrk_nemo, ONLY:   sp => wrk_3d_9 
     683      USE wrk_nemo, ONLY:   sp => wrk_3d_10 
     684      USE wrk_nemo, ONLY:   sp => wrk_3d_11 
     685      !! 
     686      !!---------------------------------------------------------------------- 
     687      !! 
     688      INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear 
     689      INTEGER, INTENT(in) ::   kt                   ! ocean time-step index 
     690      !! 
     691      INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices 
     692      REAL(wp) ::   zcoef0, znad                    ! temporary scalars 
     693      !! 
     694      !! The local variables for the correction term 
     695      INTEGER  :: jk1, jis, jid, jjs, jjd 
     696      REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps 
     697      REAL(wp) :: zrhdt1  
     698      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
     699      INTEGER  :: zbhitwe, zbhitns 
     700      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdeptht, zrhh  
     701      !!---------------------------------------------------------------------- 
     702 
     703      IF( wrk_in_use(3, 3,4,5,6,7,8,9,10,11) ) THEN 
     704         CALL ctl_stop('dyn:hpg_prj: requested workspace arrays unavailable')   ;   RETURN 
    872705      ENDIF 
    873706      ! 
    874       zhpi => tsa(:,:,:,1)  
    875       zhpj => tsa(:,:,:,2)  
     707      zdeptht => tsa(:,:,:,1)  
     708      zrhh    => tsa(:,:,:,2)  
    876709 
    877710      IF( kt == nit000 ) THEN 
    878711         IF(lwp) WRITE(numout,*) 
    879          IF(lwp) WRITE(numout,*) 'dyn:hpg_rot : hydrostatic pressure gradient trend' 
    880          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, rotated axes scheme used' 
     712         IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend' 
     713         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian' 
    881714      ENDIF 
    882715 
    883       ! ------------------------------- 
    884       !  Local constant initialization 
    885       ! ------------------------------- 
    886       zcoef0 = - grav * 0.5_wp 
    887       zforg  = 0.95_wp 
    888       zfrot  = 1._wp - zforg 
    889  
    890       ! inverse of the distance between 2 diagonal T-points (defined at F-point) (here zcoef0/distance) 
    891       zdistr(:,:) = zcoef0 / SQRT( e1f(:,:)*e1f(:,:) + e2f(:,:)*e1f(:,:) ) 
    892  
    893       ! sinus and cosinus of diagonal angle at F-point 
    894       zsina(:,:) = ATAN2( e2f(:,:), e1f(:,:) ) 
    895       zcosa(:,:) = COS( zsina(:,:) ) 
    896       zsina(:,:) = SIN( zsina(:,:) ) 
    897  
    898       ! --------------- 
    899       !  Surface value 
    900       ! --------------- 
    901       ! compute and add to the general trend the pressure gradients along the axes 
    902       DO jj = 2, jpjm1 
    903          DO ji = fs_2, fs_jpim1   ! vector opt. 
    904             ! hydrostatic pressure gradient along s-surfaces 
    905             zhpiorg(ji,jj,1) = zcoef0 / e1u(ji,jj) * (  fse3t(ji+1,jj,1) * rhd(ji+1,jj,1)   & 
    906                &                                      - fse3t(ji  ,jj,1) * rhd(ji  ,jj,1)  ) 
    907             zhpjorg(ji,jj,1) = zcoef0 / e2v(ji,jj) * (  fse3t(ji,jj+1,1) * rhd(ji,jj+1,1)   & 
    908                &                                      - fse3t(ji,jj  ,1) * rhd(ji,jj  ,1)  ) 
    909             ! s-coordinate pressure gradient correction 
    910             zuap = -zcoef0 * ( rhd   (ji+1,jj  ,1) + rhd   (ji,jj,1) )   & 
    911                &           * ( fsdept(ji+1,jj  ,1) - fsdept(ji,jj,1) ) / e1u(ji,jj) 
    912             zvap = -zcoef0 * ( rhd   (ji  ,jj+1,1) + rhd   (ji,jj,1) )   & 
    913                &           * ( fsdept(ji  ,jj+1,1) - fsdept(ji,jj,1) ) / e2v(ji,jj) 
    914             ! add to the general momentum trend 
    915             ua(ji,jj,1) = ua(ji,jj,1) + zforg * ( zhpiorg(ji,jj,1) + zuap ) 
    916             va(ji,jj,1) = va(ji,jj,1) + zforg * ( zhpjorg(ji,jj,1) + zvap ) 
    917          END DO 
    918       END DO 
    919  
    920       ! compute the pressure gradients in the diagonal directions 
    921       DO jj = 1, jpjm1 
    922          DO ji = 1, fs_jpim1   ! vector opt. 
    923             zmskd1 = tmask(ji+1,jj+1,1) * tmask(ji  ,jj,1)      ! mask in the 1st diagnonal 
    924             zmskd2 = tmask(ji  ,jj+1,1) * tmask(ji+1,jj,1)      ! mask in the 2nd diagnonal 
    925             ! hydrostatic pressure gradient along s-surfaces 
    926             zhpitra(ji,jj,1) = zdistr(ji,jj) * zmskd1 * (  fse3t(ji+1,jj+1,1) * rhd(ji+1,jj+1,1)   & 
    927                &                                         - fse3t(ji  ,jj  ,1) * rhd(ji  ,jj  ,1)  ) 
    928             zhpjtra(ji,jj,1) = zdistr(ji,jj) * zmskd2 * (  fse3t(ji  ,jj+1,1) * rhd(ji  ,jj+1,1)   & 
    929                &                                         - fse3t(ji+1,jj  ,1) * rhd(ji+1,jj  ,1)  ) 
    930             ! s-coordinate pressure gradient correction 
    931             zuap = -zdistr(ji,jj) * zmskd1 * ( rhd   (ji+1,jj+1,1) + rhd   (ji  ,jj,1) )   & 
    932                &                           * ( fsdept(ji+1,jj+1,1) - fsdept(ji  ,jj,1) ) 
    933             zvap = -zdistr(ji,jj) * zmskd2 * ( rhd   (ji  ,jj+1,1) + rhd   (ji+1,jj,1) )   & 
    934                &                           * ( fsdept(ji  ,jj+1,1) - fsdept(ji+1,jj,1) ) 
    935             ! back rotation 
    936             zhpine(ji,jj,1) = zcosa(ji,jj) * ( zhpitra(ji,jj,1) + zuap )   & 
    937                &            - zsina(ji,jj) * ( zhpjtra(ji,jj,1) + zvap ) 
    938             zhpjne(ji,jj,1) = zsina(ji,jj) * ( zhpitra(ji,jj,1) + zuap )   & 
    939                &            + zcosa(ji,jj) * ( zhpjtra(ji,jj,1) + zvap ) 
    940          END DO 
    941       END DO 
    942  
    943       ! interpolate and add to the general trend the diagonal gradient 
    944       DO jj = 2, jpjm1 
    945          DO ji = fs_2, fs_jpim1   ! vector opt. 
    946             ! averaging 
    947             zhpirot(ji,jj,1) = 0.5 * ( zhpine(ji,jj,1) + zhpine(ji  ,jj-1,1) ) 
    948             zhpjrot(ji,jj,1) = 0.5 * ( zhpjne(ji,jj,1) + zhpjne(ji-1,jj  ,1) ) 
    949             ! add to the general momentum trend 
    950             ua(ji,jj,1) = ua(ji,jj,1) + zfrot * zhpirot(ji,jj,1)  
    951             va(ji,jj,1) = va(ji,jj,1) + zfrot * zhpjrot(ji,jj,1)  
    952          END DO 
    953       END DO 
    954  
    955       ! ----------------- 
    956       ! 2. interior value (2=<jk=<jpkm1) 
    957       ! ----------------- 
    958       ! compute and add to the general trend the pressure gradients along the axes 
    959       DO jk = 2, jpkm1 
    960          DO jj = 2, jpjm1 
    961             DO ji = fs_2, fs_jpim1   ! vector opt. 
    962                ! hydrostatic pressure gradient along s-surfaces 
    963                zhpiorg(ji,jj,jk) = zhpiorg(ji,jj,jk-1)                                                 & 
    964                   &              +  zcoef0 / e1u(ji,jj) * (  fse3t(ji+1,jj,jk  ) * rhd(ji+1,jj,jk  )   & 
    965                   &                                        - fse3t(ji  ,jj,jk  ) * rhd(ji  ,jj,jk  )   & 
    966                   &                                        + fse3t(ji+1,jj,jk-1) * rhd(ji+1,jj,jk-1)   & 
    967                   &                                        - fse3t(ji  ,jj,jk-1) * rhd(ji  ,jj,jk-1)  ) 
    968                zhpjorg(ji,jj,jk) = zhpjorg(ji,jj,jk-1)                                                 & 
    969                   &              +  zcoef0 / e2v(ji,jj) * (  fse3t(ji,jj+1,jk  ) * rhd(ji,jj+1,jk  )   & 
    970                   &                                        - fse3t(ji,jj  ,jk  ) * rhd(ji,jj,  jk  )   & 
    971                   &                                        + fse3t(ji,jj+1,jk-1) * rhd(ji,jj+1,jk-1)   & 
    972                   &                                        - fse3t(ji,jj  ,jk-1) * rhd(ji,jj,  jk-1)  ) 
    973                ! s-coordinate pressure gradient correction 
    974                zuap = - zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) )   & 
    975                   &            * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
    976                zvap = - zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) )   & 
    977                   &            * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj) 
    978                ! add to the general momentum trend 
    979                ua(ji,jj,jk) = ua(ji,jj,jk) + zforg*( zhpiorg(ji,jj,jk) + zuap ) 
    980                va(ji,jj,jk) = va(ji,jj,jk) + zforg*( zhpjorg(ji,jj,jk) + zvap ) 
    981             END DO 
    982          END DO 
    983       END DO 
    984  
    985       ! compute the pressure gradients in the diagonal directions 
    986       DO jk = 2, jpkm1 
    987          DO jj = 1, jpjm1 
    988             DO ji = 1, fs_jpim1   ! vector opt. 
    989                zmskd1  = tmask(ji+1,jj+1,jk  ) * tmask(ji  ,jj,jk  )      ! level jk   mask in the 1st diagnonal 
    990                zmskd1m = tmask(ji+1,jj+1,jk-1) * tmask(ji  ,jj,jk-1)      ! level jk-1    "               "      
    991                zmskd2  = tmask(ji  ,jj+1,jk  ) * tmask(ji+1,jj,jk  )      ! level jk   mask in the 2nd diagnonal 
    992                zmskd2m = tmask(ji  ,jj+1,jk-1) * tmask(ji+1,jj,jk-1)      ! level jk-1    "               "      
    993                ! hydrostatic pressure gradient along s-surfaces 
    994                zhpitra(ji,jj,jk) = zhpitra(ji,jj,jk-1)                                                       & 
    995                   &              + zdistr(ji,jj) * zmskd1  * ( fse3t(ji+1,jj+1,jk  ) * rhd(ji+1,jj+1,jk)     & 
    996                   &                                           -fse3t(ji  ,jj  ,jk  ) * rhd(ji  ,jj  ,jk) )   & 
    997                   &              + zdistr(ji,jj) * zmskd1m * ( fse3t(ji+1,jj+1,jk-1) * rhd(ji+1,jj+1,jk-1)   & 
    998                   &                                           -fse3t(ji  ,jj  ,jk-1) * rhd(ji  ,jj  ,jk-1) ) 
    999                zhpjtra(ji,jj,jk) = zhpjtra(ji,jj,jk-1)                                                       & 
    1000                   &              + zdistr(ji,jj) * zmskd2  * ( fse3t(ji  ,jj+1,jk  ) * rhd(ji  ,jj+1,jk)     & 
    1001                   &                                           -fse3t(ji+1,jj  ,jk  ) * rhd(ji+1,jj,  jk) )   & 
    1002                   &              + zdistr(ji,jj) * zmskd2m * ( fse3t(ji  ,jj+1,jk-1) * rhd(ji  ,jj+1,jk-1)   & 
    1003                   &                                           -fse3t(ji+1,jj  ,jk-1) * rhd(ji+1,jj,  jk-1) ) 
    1004                ! s-coordinate pressure gradient correction 
    1005                zuap = - zdistr(ji,jj) * zmskd1 * ( rhd   (ji+1,jj+1,jk) + rhd   (ji  ,jj,jk) )   & 
    1006                   &                            * ( fsdept(ji+1,jj+1,jk) - fsdept(ji  ,jj,jk) ) 
    1007                zvap = - zdistr(ji,jj) * zmskd2 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji+1,jj,jk) )   & 
    1008                   &                            * ( fsdept(ji  ,jj+1,jk) - fsdept(ji+1,jj,jk) ) 
    1009                ! back rotation 
    1010                zhpine(ji,jj,jk) = zcosa(ji,jj) * ( zhpitra(ji,jj,jk) + zuap )   & 
    1011                   &             - zsina(ji,jj) * ( zhpjtra(ji,jj,jk) + zvap ) 
    1012                zhpjne(ji,jj,jk) = zsina(ji,jj) * ( zhpitra(ji,jj,jk) + zuap )   & 
    1013                   &             + zcosa(ji,jj) * ( zhpjtra(ji,jj,jk) + zvap ) 
    1014             END DO 
    1015          END DO 
    1016       END DO 
    1017  
    1018       ! interpolate and add to the general trend 
    1019       DO jk = 2, jpkm1 
    1020          DO jj = 2, jpjm1 
    1021             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1022                ! averaging 
    1023                zhpirot(ji,jj,jk) = 0.5 * ( zhpine(ji,jj,jk) + zhpine(ji  ,jj-1,jk) ) 
    1024                zhpjrot(ji,jj,jk) = 0.5 * ( zhpjne(ji,jj,jk) + zhpjne(ji-1,jj  ,jk) ) 
    1025                ! add to the general momentum trend 
    1026                ua(ji,jj,jk) = ua(ji,jj,jk) + zfrot * zhpirot(ji,jj,jk)  
    1027                va(ji,jj,jk) = va(ji,jj,jk) + zfrot * zhpjrot(ji,jj,jk)  
    1028             END DO 
    1029          END DO 
    1030       END DO 
    1031       ! 
    1032       IF( wrk_not_released(2, 1,2,3)           .OR.   & 
    1033           wrk_not_released(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot: failed to release workspace arrays') 
    1034       ! 
    1035    END SUBROUTINE hpg_rot 
     716      !!---------------------------------------------------------------------- 
     717      ! Local constant initialization 
     718      zcoef0 = - grav  
     719      znad = 0.0_wp 
     720      IF( lk_vvl ) znad = 1._wp 
     721 
     722      ! Clean 3-D work arrays 
     723      zhpi(:,:,:) = 0._wp 
     724      zrhh(:,:,:) = rhd(:,:,:) 
     725       
     726      ! Preparing vertical density profile for hybrid-sco coordinate 
     727      DO jj = 1, jpj 
     728        DO ji = 1, jpi    
     729          jk = mbathy(ji,jj) 
     730          IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp 
     731          ELSE IF(jk == 1) THEN; zrhh(ji,jj, jk+1:jpk) = rhd(ji,jj,jk) 
     732          ELSE IF(jk < jpkm1) THEN 
     733             DO jkk = jk+1, jpk 
     734                zrhh(ji,jj,jkk) = interp1(fsde3w(ji,jj,jkk),   fsde3w(ji,jj,jkk-1), & 
     735                                         fsde3w(ji,jj,jkk-2), rhd(ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
     736             END DO  
     737          ENDIF 
     738        END DO 
     739      END DO 
     740 
     741      DO jj = 1, jpj 
     742        DO ji = 1, jpi 
     743          zdeptht(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) 
     744          zdeptht(ji,jj,1) = zdeptht(ji,jj,1) - sshn(ji,jj) * znad 
     745          DO jk = 2, jpk 
     746             zdeptht(ji,jj,jk) = zdeptht(ji,jj,jk-1) + fse3w(ji,jj,jk) 
     747          END DO 
     748        END DO 
     749      END DO 
     750 
     751      DO jk = 1, jpkm1 
     752        DO jj = 1, jpj 
     753          DO ji = 1, jpi 
     754            fsp(ji,jj,jk) = zrhh(ji,jj,jk) 
     755            xsp(ji,jj,jk) = zdeptht(ji,jj,jk) 
     756          END DO 
     757        END DO 
     758      END DO 
     759 
     760      ! Construct the vertical density profile with the  
     761      ! constrained cubic spline interpolation 
     762      CALL cspline(fsp,xsp,asp,bsp,csp,dsp,polynomial_type)       
     763 
     764      ! Calculate the hydrostatic pressure at T(ji,jj,1) 
     765      DO jj = 2, jpj 
     766        DO ji = 2, jpi  
     767          zrhdt1 = zrhh(ji,jj,1) - interp3(zdeptht(ji,jj,1),asp(ji,jj,1), & 
     768                                         bsp(ji,jj,1),   csp(ji,jj,1), & 
     769                                         dsp(ji,jj,1) ) * 0.5_wp * zdeptht(ji,jj,1) 
     770          zrhdt1 = MAX(zrhdt1, 1000._wp - rau0)        ! no lighter than fresh water 
     771 
     772          ! assuming linear profile across the top half surface layer 
     773          zhpi(ji,jj,1) =  0.5_wp * fse3w(ji,jj,1) * zrhdt1   
     774        END DO 
     775      END DO 
     776 
     777      ! Calculate the pressure at T(ji,jj,2:jpkm1) 
     778      DO jk = 2, jpkm1                                   
     779        DO jj = 2, jpj      
     780          DO ji = 2, jpi 
     781            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                          & 
     782                             integ2(zdeptht(ji,jj,jk-1), zdeptht(ji,jj,jk),& 
     783                                    asp(ji,jj,jk-1),    bsp(ji,jj,jk-1), & 
     784                                    csp(ji,jj,jk-1),    dsp(ji,jj,jk-1)) 
     785          END DO 
     786        END DO 
     787      END DO 
     788 
     789      ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 
     790      DO jj = 2, jpjm1      
     791        DO ji = 2, jpim1   
     792          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad) 
     793          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_n(ji,jj) * znad) 
     794        END DO 
     795      END DO 
     796 
     797      DO jk = 2, jpkm1                                   
     798        DO jj = 2, jpjm1      
     799          DO ji = 2, jpim1   
     800            zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk) 
     801            zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk) 
     802          END DO 
     803        END DO 
     804      END DO 
     805                
     806      DO jk = 1, jpkm1                                   
     807        DO jj = 2, jpjm1      
     808          DO ji = 2, jpim1   
     809            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk) 
     810            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk) 
     811          END DO 
     812        END DO 
     813      END DO 
     814 
     815      DO jk = 1, jpkm1                                   
     816        DO jj = 2, jpjm1      
     817          DO ji = 2, jpim1   
     818            zpwes = 0._wp; zpwed = 0._wp 
     819            zpnss = 0._wp; zpnsd = 0._wp 
     820            zuijk = zu(ji,jj,jk) 
     821            zvijk = zv(ji,jj,jk) 
     822 
     823            !!!!!     for u equation 
     824            IF( jk <= mbku(ji,jj) ) THEN 
     825               IF( -zdeptht(ji+1,jj,mbku(ji,jj)) >= -zdeptht(ji,jj,mbku(ji,jj)) ) THEN 
     826                 jis = ji + 1; jid = ji 
     827               ELSE 
     828                 jis = ji;     jid = ji +1 
     829               ENDIF 
     830 
     831               ! integrate the pressure on the shallow side 
     832               jk1 = jk  
     833               zbhitwe = 0 
     834               DO WHILE ( -zdeptht(jis,jj,jk1) > zuijk ) 
     835                 IF( jk1 == mbku(ji,jj) ) THEN 
     836                   zbhitwe = 1 
     837                   EXIT 
     838                 ENDIF 
     839                 zdeps = MIN(zdeptht(jis,jj,jk1+1), -zuijk) 
     840                 zpwes = zpwes +                                    &  
     841                      integ2(zdeptht(jis,jj,jk1), zdeps,            & 
     842                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
     843                             csp(jis,jj,jk1),    dsp(jis,jj,jk1)) 
     844                 jk1 = jk1 + 1 
     845               END DO 
     846             
     847               IF(zbhitwe == 1) THEN 
     848                 zuijk = -zdeptht(jis,jj,jk1) 
     849               ENDIF 
     850 
     851               ! integrate the pressure on the deep side 
     852               jk1 = jk  
     853               zbhitwe = 0 
     854               DO WHILE ( -zdeptht(jid,jj,jk1) < zuijk ) 
     855                 IF( jk1 == 1 ) THEN 
     856                   zbhitwe = 1 
     857                   EXIT 
     858                 ENDIF 
     859                 zdeps = MAX(zdeptht(jid,jj,jk1-1), -zuijk) 
     860                 zpwed = zpwed +                                        &  
     861                        integ2(zdeps,              zdeptht(jid,jj,jk1), & 
     862                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
     863                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
     864                 jk1 = jk1 - 1 
     865               END DO 
     866             
     867               IF( zbhitwe == 1 ) THEN 
     868                 zdeps = zdeptht(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 
     869                 zrhdt1 = zrhh(jid,jj,1) - interp3(zdeptht(jid,jj,1), asp(jid,jj,1), & 
     870                                                 bsp(jid,jj,1),    csp(jid,jj,1), & 
     871                                                 dsp(jid,jj,1)) * zdeps 
     872                 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0)        ! no lighter than fresh water 
     873                 zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
     874               ENDIF 
     875 
     876               ! update the momentum trends in u direction 
     877 
     878               zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
     879               IF( lk_vvl ) THEN 
     880                 zdpdx2 = zcoef0 / e1u(ji,jj) * &  
     881                         ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )  
     882                ELSE 
     883                 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)  
     884               ENDIF 
     885 
     886               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * & 
     887               &           umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 
     888            ENDIF 
     889   
     890            !!!!!     for v equation 
     891            IF( jk <= mbkv(ji,jj) ) THEN 
     892               IF( -zdeptht(ji,jj+1,mbkv(ji,jj)) >= -zdeptht(ji,jj,mbkv(ji,jj)) ) THEN 
     893                 jjs = jj + 1; jjd = jj 
     894               ELSE 
     895                 jjs = jj    ; jjd = jj + 1 
     896               ENDIF 
     897 
     898               ! integrate the pressure on the shallow side 
     899               jk1 = jk  
     900               zbhitns = 0 
     901               DO WHILE ( -zdeptht(ji,jjs,jk1) > zvijk ) 
     902                 IF( jk1 == mbkv(ji,jj) ) THEN 
     903                   zbhitns = 1 
     904                   EXIT 
     905                 ENDIF 
     906                 zdeps = MIN(zdeptht(ji,jjs,jk1+1), -zvijk) 
     907                 zpnss = zpnss +                                      &  
     908                        integ2(zdeptht(ji,jjs,jk1), zdeps,            & 
     909                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
     910                               csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) ) 
     911                 jk1 = jk1 + 1 
     912               END DO 
     913             
     914               IF(zbhitns == 1) THEN 
     915                 zvijk = -zdeptht(ji,jjs,jk1) 
     916               ENDIF 
     917 
     918               ! integrate the pressure on the deep side 
     919               jk1 = jk  
     920               zbhitns = 0 
     921               DO WHILE ( -zdeptht(ji,jjd,jk1) < zvijk ) 
     922                 IF( jk1 == 1 ) THEN 
     923                   zbhitns = 1 
     924                   EXIT 
     925                 ENDIF 
     926                 zdeps = MAX(zdeptht(ji,jjd,jk1-1), -zvijk) 
     927                 zpnsd = zpnsd +                                        &  
     928                        integ2(zdeps,              zdeptht(ji,jjd,jk1), & 
     929                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
     930                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
     931                 jk1 = jk1 - 1 
     932               END DO 
     933             
     934               IF( zbhitns == 1 ) THEN 
     935                 zdeps = zdeptht(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 
     936                 zrhdt1 = zrhh(ji,jjd,1) - interp3(zdeptht(ji,jjd,1), asp(ji,jjd,1), & 
     937                                                 bsp(ji,jjd,1),    csp(ji,jjd,1), & 
     938                                                 dsp(ji,jjd,1) ) * zdeps 
     939                 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0)        ! no lighter than fresh water 
     940                 zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
     941               ENDIF 
     942 
     943               ! update the momentum trends in v direction 
     944 
     945               zdpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 
     946               IF( lk_vvl ) THEN 
     947                   zdpdy2 = zcoef0 / e2v(ji,jj) * & 
     948                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )  
     949               ELSE 
     950                   zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )  
     951               ENDIF 
     952 
     953               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*& 
     954               &              vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 
     955            ENDIF 
     956 
     957                     
     958           END DO 
     959        END DO 
     960      END DO 
     961 
     962      ! 
     963      IF( wrk_not_released(3, 3,4,5,6,7,8,9,10,11) )   & 
     964         CALL ctl_stop('dyn:hpg_prj: failed to release workspace arrays') 
     965      ! 
     966   END SUBROUTINE hpg_prj 
     967 
     968   SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 
     969      !!---------------------------------------------------------------------- 
     970      !!                 ***  ROUTINE cspline  *** 
     971      !!        
     972      !! ** Purpose :   constrained cubic spline interpolation 
     973      !!           
     974      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3  
     975      !! Reference: K.W. Brodlie, A review of mehtods for curve and function 
     976      !!                          drawing, 1980 
     977      !! 
     978      !!---------------------------------------------------------------------- 
     979      IMPLICIT NONE 
     980      REAL(wp), DIMENSION(:,:,:), INTENT(in)  :: fsp, xsp           ! value and coordinate 
     981      REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of  
     982                                                                    ! the interpoated function 
     983      INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline  
     984                                                                    ! 2: Linear 
     985 
     986      ! Local Variables       
     987      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
     988      INTEGER  ::   jpi, jpj, jpkm1 
     989      REAL(wp) ::   zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp 
     990      REAL(wp) ::   zdxtmp1, zdxtmp2, zalpha 
     991      REAL(wp) ::   zdf(size(fsp,3)) 
     992      !!---------------------------------------------------------------------- 
     993 
     994      jpi   = size(fsp,1) 
     995      jpj   = size(fsp,2) 
     996      jpkm1 = size(fsp,3) - 1 
     997 
     998      ! Clean output arrays 
     999      asp = 0.0_wp 
     1000      bsp = 0.0_wp 
     1001      csp = 0.0_wp 
     1002      dsp = 0.0_wp 
     1003       
     1004      DO ji = 1, jpi 
     1005        DO jj = 1, jpj 
     1006          IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline 
     1007             DO jk = 2, jpkm1-1 
     1008                zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1)   
     1009                zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)   
     1010                zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1 
     1011                zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2 
     1012    
     1013                zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 
     1014               
     1015                IF(zdf1 * zdf2 <= 0._wp) THEN 
     1016                    zdf(jk) = 0._wp 
     1017                ELSE 
     1018                  zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 ) 
     1019                ENDIF 
     1020             END DO 
     1021 
     1022             zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 
     1023                        &          ( xsp(ji,jj,2) - xsp(ji,jj,1) ) -  0.5_wp * zdf(2) 
     1024             zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / & 
     1025                        &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - & 
     1026                        & 0.5_wp * zdf(jpkm1 - 1) 
     1027    
     1028             DO jk = 1, jpkm1 - 1 
     1029                zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)  
     1030                ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 
     1031                ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 
     1032                zddf1  = -2._wp * ztmp1 + ztmp2  
     1033                ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 
     1034                zddf2  =  2._wp * ztmp1 - ztmp2  
     1035    
     1036                dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 
     1037                csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 
     1038                bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - &  
     1039                              & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 
     1040                              & dsp(ji,jj,jk) * ( xsp(ji,jj,jk+1)**2 + & 
     1041                              &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk) + & 
     1042                              &                   xsp(ji,jj,jk)**2 ) 
     1043                asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) - & 
     1044                              &                 csp(ji,jj,jk) * xsp(ji,jj,jk)**2 - & 
     1045                              &                 dsp(ji,jj,jk) * xsp(ji,jj,jk)**3 
     1046             END DO 
     1047  
     1048          ELSE IF (polynomial_type == 2) THEN     ! Linear 
     1049  
     1050             DO jk = 1, jpkm1-1 
     1051                zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk)  
     1052                ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 
     1053    
     1054                dsp(ji,jj,jk) = 0._wp 
     1055                csp(ji,jj,jk) = 0._wp 
     1056                bsp(ji,jj,jk) = ztmp1 / zdxtmp 
     1057                asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) 
     1058             END DO 
     1059 
     1060          ELSE 
     1061             CALL ctl_stop( 'invalid polynomial type in cspline' ) 
     1062          ENDIF 
     1063 
     1064        END DO 
     1065      END DO 
     1066       
     1067   END SUBROUTINE cspline 
     1068 
     1069 
     1070   FUNCTION interp1(x, xl, xr, fl, fr)  RESULT(f)  
     1071      !!---------------------------------------------------------------------- 
     1072      !!                 ***  ROUTINE interp1  *** 
     1073      !!        
     1074      !! ** Purpose :   1-d linear interpolation 
     1075      !!           
     1076      !! ** Method  :   
     1077      !!                interpolation is straight forward 
     1078      !!                extrapolation is also permitted (no value limit)  
     1079      !! 
     1080      !! H.Liu, Jan 2009,  POL  
     1081      !!---------------------------------------------------------------------- 
     1082      IMPLICIT NONE 
     1083      REAL(wp), INTENT(in) ::  x, xl, xr, fl, fr    
     1084      REAL(wp)             ::  f ! result of the interpolation (extrapolation) 
     1085      REAL(wp)             ::  zdeltx 
     1086      !!---------------------------------------------------------------------- 
     1087 
     1088      zdeltx = xr - xl 
     1089      IF(abs(zdeltx) <= 10._wp * EPSILON(x)) THEN 
     1090        f = 0.5_wp * (fl + fr) 
     1091      ELSE 
     1092        f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx 
     1093      ENDIF 
     1094       
     1095   END FUNCTION interp1 
     1096 
     1097   FUNCTION interp2(x, a, b, c, d)  RESULT(f)  
     1098      !!---------------------------------------------------------------------- 
     1099      !!                 ***  ROUTINE interp1  *** 
     1100      !!        
     1101      !! ** Purpose :   1-d constrained cubic spline interpolation 
     1102      !!           
     1103      !! ** Method  :  cubic spline interpolation 
     1104      !! 
     1105      !!---------------------------------------------------------------------- 
     1106      IMPLICIT NONE 
     1107      REAL(wp), INTENT(in) ::  x, a, b, c, d    
     1108      REAL(wp)             ::  f ! value from the interpolation 
     1109      !!---------------------------------------------------------------------- 
     1110 
     1111      f = a + x* ( b + x * ( c + d * x ) )  
     1112 
     1113   END FUNCTION interp2 
     1114 
     1115 
     1116   FUNCTION interp3(x, a, b, c, d)  RESULT(f)  
     1117      !!---------------------------------------------------------------------- 
     1118      !!                 ***  ROUTINE interp1  *** 
     1119      !!        
     1120      !! ** Purpose :   Calculate the first order of deriavtive of 
     1121      !!                a cubic spline function y=a+b*x+c*x^2+d*x^3 
     1122      !!           
     1123      !! ** Method  :   f=dy/dx=b+2*c*x+3*d*x^2 
     1124      !! 
     1125      !!---------------------------------------------------------------------- 
     1126      IMPLICIT NONE 
     1127      REAL(wp), INTENT(in) ::  x, a, b, c, d    
     1128      REAL(wp)             ::  f ! value from the interpolation 
     1129      !!---------------------------------------------------------------------- 
     1130 
     1131      f = b + x * ( 2._wp * c + 3._wp * d * x) 
     1132 
     1133   END FUNCTION interp3 
     1134 
     1135    
     1136   FUNCTION integ2(xl, xr, a, b, c, d)  RESULT(f)  
     1137      !!---------------------------------------------------------------------- 
     1138      !!                 ***  ROUTINE interp1  *** 
     1139      !!        
     1140      !! ** Purpose :   1-d constrained cubic spline integration 
     1141      !!           
     1142      !! ** Method  :  integrate polynomial a+bx+cx^2+dx^3 from xl to xr  
     1143      !! 
     1144      !!---------------------------------------------------------------------- 
     1145      IMPLICIT NONE 
     1146      REAL(wp), INTENT(in) ::  xl, xr, a, b, c, d    
     1147      REAL(wp)             ::  za1, za2, za3       
     1148      REAL(wp)             ::  f                   ! integration result 
     1149      !!---------------------------------------------------------------------- 
     1150 
     1151      za1 = 0.5_wp * b  
     1152      za2 = c / 3.0_wp  
     1153      za3 = 0.25_wp * d  
     1154 
     1155      f  = xr * ( a + xr * ( za1 + xr * ( za2 + za3 * xr ) ) ) - & 
     1156         & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) ) 
     1157 
     1158   END FUNCTION integ2 
     1159 
    10361160 
    10371161   !!====================================================================== 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2977 r3116  
    3333   USE obcdyn_bt       ! 2D open boundary condition for momentum (obc_dyn_bt routine) 
    3434   USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    35    USE bdy_oce         ! unstructured open boundary conditions 
    36    USE bdydta          ! unstructured open boundary conditions 
    37    USE bdydyn          ! unstructured open boundary conditions 
     35   USE bdy_oce         ! ocean open boundary conditions 
     36   USE bdydta          ! ocean open boundary conditions 
     37   USE bdydyn          ! ocean open boundary conditions 
     38   USE bdyvol          ! ocean open boundary condition (bdy_vol routines) 
    3839   USE in_out_manager  ! I/O manager 
    3940   USE lbclnk          ! lateral boundary condition (or mpp link) 
    … …  
    7778      !!              * Apply lateral boundary conditions on after velocity  
    7879      !!             at the local domain boundaries through lbc_lnk call, 
    79       !!             at the radiative open boundaries (lk_obc=T), 
    80       !!             at the relaxed   open boundaries (lk_bdy=T), and 
     80      !!             at the one-way open boundaries (lk_obc=T), 
    8181      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8282      !! 
    … …  
    9292      !!               un,vn   now horizontal velocity of next time-step 
    9393      !!---------------------------------------------------------------------- 
    94       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    9594      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    96       USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 
    9795      ! 
    9896      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    9997      ! 
    10098      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     99      INTEGER  ::   iku, ikv     ! local integers 
    101100#if ! defined key_dynspg_flt 
    102101      REAL(wp) ::   z2dt         ! temporary scalar 
    103102#endif 
    104       REAL(wp) ::   zue3a, zue3n, zue3b, zuf    ! local scalars 
    105       REAL(wp) ::   zve3a, zve3n, zve3b, zvf    !   -      - 
    106       REAL(wp) ::   zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 
     103      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec   ! local scalars 
     104      REAL(wp) ::   zve3a, zve3n, zve3b, zvf        !   -      - 
    107105      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f  
    108106      !!---------------------------------------------------------------------- 
    109107 
    110       IF( wrk_in_use(2, 1,2,3) ) THEN 
    111          CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable')   ;   RETURN 
    112       ENDIF 
    113108      ! 
    114109      ze3u_f => tsa(:,:,:,1)  
    … …  
    178173      ENDIF 
    179174      ! 
    180 # elif defined key_bdy  
     175# elif defined key_bdy 
    181176      !                                !* BDY open boundaries 
    182       IF( .NOT. lk_dynspg_flt ) THEN 
    183          CALL bdy_dyn_frs( kt ) 
    184 #  if ! defined key_vvl 
    185          ua_e(:,:) = 0.e0 
    186          va_e(:,:) = 0.e0 
    187          ! Set these variables for use in bdy_dyn_fla 
    188          hur_e(:,:) = hur(:,:) 
    189          hvr_e(:,:) = hvr(:,:) 
    190          DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    191             ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    192             va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    193          END DO 
    194          ua_e(:,:) = ua_e(:,:) * hur(:,:) 
    195          va_e(:,:) = va_e(:,:) * hvr(:,:) 
    196          DO jk = 1 , jpkm1 
    197             ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) 
    198             va(:,:,jk) = va(:,:,jk) - va_e(:,:) 
    199          END DO 
    200          CALL bdy_dta_fla( kt+1, 0,2*nn_baro) 
    201          CALL bdy_dyn_fla( sshn_b ) 
    202          CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated 
    203          CALL lbc_lnk( va_e, 'V', -1. )   ! 
    204          DO jk = 1 , jpkm1 
    205             ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk) 
    206             va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk) 
    207          END DO 
    208 #  endif 
    209       ENDIF 
     177      IF( lk_dynspg_exp ) CALL bdy_dyn( kt ) 
     178      IF( lk_dynspg_ts )  CALL bdy_dyn( kt, dyn3d_only=.true. ) 
     179 
     180!!$   Do we need a call to bdy_vol here?? 
     181      ! 
    210182# endif 
    211183      ! 
    … …  
    242214         ELSE                             ! Variable volume ! 
    243215            !                             ! ================! 
    244             ! Before scale factor at t-points 
    245             ! ------------------------------- 
    246             DO jk = 1, jpkm1 
     216            ! 
     217            DO jk = 1, jpkm1                 ! Before scale factor at t-points 
    247218               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)                                   & 
    248219                  &              + atfp * (  fse3t_b(:,:,jk) + fse3t_a(:,:,jk)     & 
    249                   &                         - 2.e0 * fse3t_n(:,:,jk)            ) 
    250             ENDDO 
    251             ! Add volume filter correction only at the first level of t-point scale factors 
    252             zec = atfp * rdt / rau0 
     220                  &                         - 2._wp * fse3t_n(:,:,jk)            ) 
     221            END DO 
     222            zec = atfp * rdt / rau0          ! Add filter correction only at the 1st level of t-point scale factors 
    253223            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
    254             ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations 
    255             zs_t  (:,:) =       e1t(:,:) * e2t(:,:) 
    256             zs_u_1(:,:) = 0.5 / ( e1u(:,:) * e2u(:,:) ) 
    257             zs_v_1(:,:) = 0.5 / ( e1v(:,:) * e2v(:,:) ) 
    258224            ! 
    259             IF( ln_dynadv_vec ) THEN 
    260                ! Before scale factor at (u/v)-points 
    261                ! ----------------------------------- 
    262                ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
    263                DO jk = 1, jpkm1 
    264                   DO jj = 1, jpjm1 
    265                      DO ji = 1, jpim1 
    266                         zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
    267                         zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
    268                         zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
    269                         fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 
    270                         fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 
    271                      END DO 
    272                   END DO 
    273                END DO 
    274                ! lateral boundary conditions 
    275                CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) 
    276                CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 
    277                ! Add initial scale factor to scale factor anomaly 
    278                fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 
    279                fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
    280                ! Leap-Frog - Asselin filter and swap: applied on velocity 
    281                ! ----------------------------------- 
    282                DO jk = 1, jpkm1 
    283                   DO jj = 1, jpj 
     225            IF( ln_dynadv_vec ) THEN         ! vector invariant form (no thickness weighted calulation) 
     226               ! 
     227               !                                      ! before scale factors at u- & v-pts (computed from fse3t_b) 
     228               CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 
     229               ! 
     230               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap: applied on velocity 
     231                  DO jj = 1, jpj                      !                                                 -------- 
    284232                     DO ji = 1, jpi 
    285233                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) 
    … …  
    294242               END DO 
    295243               ! 
    296             ELSE 
    297                ! Temporary filered scale factor at (u/v)-points (will become before scale factor) 
    298                !----------------------------------------------- 
    299                ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 
    300                DO jk = 1, jpkm1 
    301                   DO jj = 1, jpjm1 
    302                      DO ji = 1, jpim1 
    303                         zv_t_ij          = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk) 
    304                         zv_t_ip1j        = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk) 
    305                         zv_t_ijp1        = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk) 
    306                         ze3u_f(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 
    307                         ze3v_f(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 
    308                      END DO 
    309                   END DO 
    310                END DO 
    311                ! lateral boundary conditions 
    312                CALL lbc_lnk( ze3u_f, 'U', 1. ) 
    313                CALL lbc_lnk( ze3v_f, 'V', 1. ) 
    314                ! Add initial scale factor to scale factor anomaly 
    315                ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 
    316                ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 
    317                ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 
    318                ! -----------------------------------             =========================== 
    319                DO jk = 1, jpkm1 
    320                   DO jj = 1, jpj 
    321                      DO ji = 1, jpim1 
     244            ELSE                             ! flux form (thickness weighted calulation) 
     245               ! 
     246               CALL dom_vvl_2( kt, ze3u_f, ze3v_f )   ! before scale factors at u- & v-pts (computed from fse3t_b) 
     247               ! 
     248               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap:  
     249                  DO jj = 1, jpj                      !                   applied on thickness weighted velocity 
     250                     DO ji = 1, jpim1                 !                              --------------------------- 
    322251                        zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 
    323252                        zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 
    … …  
    327256                        zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 
    328257                        ! 
    329                         zuf  = ( zue3n + atfp * ( zue3b - 2.e0 * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
    330                         zvf  = ( zve3n + atfp * ( zve3b - 2.e0 * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
     258                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
     259                        zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
    331260                        ! 
    332                         ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
     261                        ub(ji,jj,jk) = zuf                     ! ub <-- filtered velocity 
    333262                        vb(ji,jj,jk) = zvf 
    334                         un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
     263                        un(ji,jj,jk) = ua(ji,jj,jk)            ! un <-- ua 
    335264                        vn(ji,jj,jk) = va(ji,jj,jk) 
    336265                     END DO 
    337266                  END DO 
    338267               END DO 
    339                fse3u_b(:,:,:) = ze3u_f(:,:,:)                   ! e3u_b <-- filtered scale factor 
    340                fse3v_b(:,:,:) = ze3v_f(:,:,:) 
    341                CALL lbc_lnk( ub, 'U', -1. )                     ! lateral boundary conditions 
     268               fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor 
     269               fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     270               CALL lbc_lnk( ub, 'U', -1. )                    ! lateral boundary conditions 
    342271               CALL lbc_lnk( vb, 'V', -1. ) 
    343272            ENDIF 
    … …  
    350279         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    351280      !  
    352       IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn_nxt: failed to release workspace arrays') 
    353       ! 
    354281   END SUBROUTINE dyn_nxt 
    355282 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2715 r3116  
    1515   USE dom_oce        ! ocean space and time domain variables 
    1616   USE phycst         ! physical constants 
    17    USE obc_oce        ! ocean open boundary conditions 
    1817   USE sbc_oce        ! surface boundary condition: ocean 
    1918   USE sbcapr         ! surface boundary condition: atmospheric pressure 
    … …  
    222221      ENDIF 
    223222 
    224 #if defined key_obc 
    225       !                        ! Conservation of ocean volume (key_dynspg_flt) 
    226       IF( lk_dynspg_flt )   ln_vol_cst = .true. 
    227  
    228       !                        ! Application of Flather's algorithm at open boundaries 
    229       IF( lk_dynspg_flt )   ln_obc_fla = .false. 
    230       IF( lk_dynspg_exp )   ln_obc_fla = .true. 
    231       IF( lk_dynspg_ts  )   ln_obc_fla = .true. 
    232 #endif 
    233223      ! 
    234224   END SUBROUTINE dyn_spg_init 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r2715 r3116  
    2121   USE phycst          ! physical constants 
    2222   USE obc_par         ! open boundary condition parameters 
    23    USE obcdta          ! open boundary condition data     (obc_dta_bt routine) 
     23   USE obcdta          ! open boundary condition data     (bdy_dta_bt routine) 
    2424   USE in_out_manager  ! I/O manager 
    2525   USE lib_mpp         ! distributed memory computing library 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2977 r3116  
    2626   USE sbc_oce         ! surface boundary condition: ocean 
    2727   USE obc_oce         ! Lateral open boundary condition 
     28   USE bdy_oce         ! Lateral open boundary condition 
    2829   USE sol_oce         ! ocean elliptic solver 
    2930   USE phycst          ! physical constants 
    … …  
    3334   USE solpcg          ! preconditionned conjugate gradient solver 
    3435   USE solsor          ! Successive Over-relaxation solver 
    35    USE obcdyn          ! ocean open boundary condition (obc_dyn routines) 
    36    USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    37    USE bdy_oce         ! Unstructured open boundaries condition 
    38    USE bdydyn          ! Unstructured open boundaries condition (bdy_dyn routine)  
    39    USE bdyvol          ! Unstructured open boundaries condition (bdy_vol routine) 
     36   USE obcdyn          ! ocean open boundary condition on dynamics 
     37   USE obcvol          ! ocean open boundary condition (obc_vol routine) 
     38   USE bdydyn          ! ocean open boundary condition on dynamics 
     39   USE bdyvol          ! ocean open boundary condition (bdy_vol routine) 
    4040   USE cla             ! cross land advection 
    4141   USE in_out_manager  ! I/O manager 
    … …  
    191191#endif 
    192192#if defined key_bdy 
    193       CALL bdy_dyn_frs( kt )       ! Update velocities on unstructured boundary using the Flow Relaxation Scheme 
    194       CALL bdy_vol( kt )           ! Correction of the barotropic component velocity to control the volume of the system 
     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 
    195195#endif 
    196196#if defined key_agrif 
    … …  
    308308#if defined key_obc 
    309309            ! caution : grad D = 0 along open boundaries 
     310            ! Remark: The filtering force could be reduced here in the FRS zone 
     311            !         by multiplying spgu/spgv by (1-alpha) ??   
    310312            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    311313            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    312314#elif defined key_bdy 
    313315            ! caution : grad D = 0 along open boundaries 
    314             ! Remark: The filtering force could be reduced here in the FRS zone 
    315             !         by multiplying spgu/spgv by (1-alpha) ??   
    316316            spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 
    317             spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)            
     317            spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 
    318318#else 
    319319            spgu(ji,jj) = z2dt * ztdgu 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r2715 r3116  
    3434 
    3535  !                                                                         !!! Time splitting scheme (key_dynspg_ts)  
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_e, ssha_e   ! sea surface heigth (now, after, average) 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ua_e  , va_e     ! barotropic velocities (after) 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e ) 
    39    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_b       ! before field without time-filter 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_e, ssha_e   ! sea surface heigth (now, after, average) 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   ua_e  , va_e     ! barotropic velocities (after) 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e ) 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_b           ! before field without time-filter 
    4141 
    4242   !!---------------------------------------------------------------------- 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r3104 r3116  
    2525   USE domvvl          ! variable volume 
    2626   USE zdfbfr          ! bottom friction 
    27    USE obcdta          ! open boundary condition data      
    28    USE obcfla          ! Flather open boundary condition   
    2927   USE dynvor          ! vorticity term 
    3028   USE obc_oce         ! Lateral open boundary condition 
    3129   USE obc_par         ! open boundary condition parameters 
    32    USE bdy_oce         ! unstructured open boundaries 
    33    USE bdy_par         ! unstructured open boundaries 
    34    USE bdydta          ! unstructured open boundaries 
    35    USE bdydyn          ! unstructured open boundaries 
    36    USE bdytides        ! tidal forcing at unstructured open boundaries. 
     30   USE obcdta          ! open boundary condition data      
     31   USE obcfla          ! Flather open boundary condition   
     32   USE bdy_par         ! for lk_bdy 
     33   USE bdy_oce         ! Lateral open boundary condition 
     34   USE bdydta          ! open boundary condition data      
     35   USE bdydyn2d        ! open boundary conditions on barotropic variables 
    3736   USE sbctide 
    3837   USE updtide 
    … …  
    121120      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    122121      INTEGER  ::   icycle           ! local scalar 
    123       REAL(wp) ::   zraur, zcoef, z2dt_e, z2dt_b     ! local scalars 
    124       REAL(wp) ::   z1_8, zx1, zy1                   !   -      - 
    125       REAL(wp) ::   z1_4, zx2, zy2                   !   -      - 
    126       REAL(wp) ::   zu_spg, zu_cor, zu_sld, zu_asp   !   -      - 
    127       REAL(wp) ::   zv_spg, zv_cor, zv_sld, zv_asp   !   -      - 
     122      INTEGER  ::   ikbu, ikbv       ! local scalar 
     123      REAL(wp) ::   zraur, zcoef, z2dt_e, z1_2dt_b, z2dt_bf   ! local scalars 
     124      REAL(wp) ::   z1_8, zx1, zy1                            !   -      - 
     125      REAL(wp) ::   z1_4, zx2, zy2                            !   -      - 
     126      REAL(wp) ::   zu_spg, zu_cor, zu_sld, zu_asp            !   -      - 
     127      REAL(wp) ::   zv_spg, zv_cor, zv_sld, zv_asp            !   -      - 
     128      REAL(wp) ::   ua_btm, va_btm                            !   -      - 
    128129      !!---------------------------------------------------------------------- 
    129130 
    … …  
    149150         hvr_e (:,:) = hvr  (:,:) 
    150151         IF( ln_dynvor_een ) THEN 
    151             ftne(1,:) = 0.e0   ;   ftnw(1,:) = 0.e0   ;   ftse(1,:) = 0.e0   ;   ftsw(1,:) = 0.e0 
     152            ftne(1,:) = 0._wp   ;   ftnw(1,:) = 0._wp   ;   ftse(1,:) = 0._wp   ;   ftsw(1,:) = 0._wp 
    152153            DO jj = 2, jpj 
    153154               DO ji = fs_2, jpi   ! vector opt. 
    154                   ftne(ji,jj) = ( ff(ji-1,jj  ) + ff(ji  ,jj  ) + ff(ji  ,jj-1) ) / 3. 
    155                   ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj  ) + ff(ji  ,jj  ) ) / 3. 
    156                   ftse(ji,jj) = ( ff(ji  ,jj  ) + ff(ji  ,jj-1) + ff(ji-1,jj-1) ) / 3. 
    157                   ftsw(ji,jj) = ( ff(ji  ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj  ) ) / 3. 
     155                  ftne(ji,jj) = ( ff(ji-1,jj  ) + ff(ji  ,jj  ) + ff(ji  ,jj-1) ) / 3._wp 
     156                  ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj  ) + ff(ji  ,jj  ) ) / 3._wp 
     157                  ftse(ji,jj) = ( ff(ji  ,jj  ) + ff(ji  ,jj-1) + ff(ji-1,jj-1) ) / 3._wp 
     158                  ftsw(ji,jj) = ( ff(ji  ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj  ) ) / 3._wp 
    158159               END DO 
    159160            END DO 
    … …  
    162163      ENDIF 
    163164 
    164       !                                   !* Local constant initialization 
    165       z2dt_b = 2.0 * rdt                                    ! baroclinic time step 
    166       z1_8 = 0.5 * 0.25                                     ! coefficient for vorticity estimates 
    167       z1_4 = 0.5 * 0.5 
    168       zraur  = 1. / rau0                                    ! 1 / volumic mass 
    169       ! 
    170       zhdiv(:,:) = 0.e0                                     ! barotropic divergence 
    171       zu_sld = 0.e0   ;   zu_asp = 0.e0                     ! tides trends (lk_tide=F) 
    172       zv_sld = 0.e0   ;   zv_asp = 0.e0 
     165      !                                                     !* Local constant initialization 
     166      z1_2dt_b = 1._wp / ( 2.0_wp * rdt )                   ! reciprocal of baroclinic time step 
     167      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt_b = 1.0_wp / rdt    ! reciprocal of baroclinic  
     168                                                                        ! time step (euler timestep) 
     169      z1_8     = 0.125_wp                                   ! coefficient for vorticity estimates 
     170      z1_4     = 0.25_wp         
     171      zraur    = 1._wp / rau0                               ! 1 / volumic mass 
     172      ! 
     173      zhdiv(:,:) = 0._wp                                    ! barotropic divergence 
     174      zu_sld = 0._wp   ;   zu_asp = 0._wp                   ! tides trends (lk_tide=F) 
     175      zv_sld = 0._wp   ;   zv_asp = 0._wp 
     176 
     177      IF( kt == nit000 .AND. neuler == 0) THEN              ! for implicit bottom friction 
     178        z2dt_bf = rdt 
     179      ELSE 
     180        z2dt_bf = 2.0_wp * rdt 
     181      ENDIF 
    173182 
    174183      ! ----------------------------------------------------------------------------- 
    … …  
    178187      !                                   !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 
    179188      !                                   ! -------------------------- 
    180       zua(:,:) = 0.e0   ;   zun(:,:) = 0.e0   ;   ub_b(:,:) = 0.e0 
    181       zva(:,:) = 0.e0   ;   zvn(:,:) = 0.e0   ;   vb_b(:,:) = 0.e0 
     189      zua(:,:) = 0._wp   ;   zun(:,:) = 0._wp   ;   ub_b(:,:) = 0._wp 
     190      zva(:,:) = 0._wp   ;   zvn(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    182191      ! 
    183192      DO jk = 1, jpkm1 
    … …  
    197206               ! 
    198207#if defined key_vvl 
    199                ub_b(ji,jj) = ub_b(ji,jj) + (fse3u_0(ji,jj,jk)*(1.+sshu_b(ji,jj)*muu(ji,jj,jk)))* ub(ji,jj,jk)  
    200                vb_b(ji,jj) = vb_b(ji,jj) + (fse3v_0(ji,jj,jk)*(1.+sshv_b(ji,jj)*muv(ji,jj,jk)))* vb(ji,jj,jk)    
     208               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk)* ub(ji,jj,jk)   *umask(ji,jj,jk)  
     209               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk)* vb(ji,jj,jk)   *vmask(ji,jj,jk) 
    201210#else 
    202211               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_0(ji,jj,jk) * ub(ji,jj,jk)  * umask(ji,jj,jk) 
    … …  
    272281      DO jj = 2, jpjm1                             ! Remove coriolis term (and possibly spg) from barotropic trend 
    273282         DO ji = fs_2, fs_jpim1 
    274             zua(ji,jj) = zua(ji,jj) - zcu(ji,jj) 
    275             zva(ji,jj) = zva(ji,jj) - zcv(ji,jj) 
    276          END DO 
     283             zua(ji,jj) = zua(ji,jj) - zcu(ji,jj) 
     284             zva(ji,jj) = zva(ji,jj) - zcv(ji,jj) 
     285          END DO 
    277286      END DO 
    278287 
    … …  
    280289      !                                             ! Remove barotropic contribution of bottom friction  
    281290      !                                             ! from the barotropic transport trend 
    282       zcoef = -1. / z2dt_b 
     291      zcoef = -1._wp * z1_2dt_b 
     292 
     293      IF(ln_bfrimp) THEN 
     294      !                                   ! Remove the bottom stress trend from 3-D sea surface level gradient 
     295      !                                   ! and Coriolis forcing in case of 3D semi-implicit bottom friction  
     296        DO jj = 2, jpjm1          
     297           DO ji = fs_2, fs_jpim1 
     298              ikbu = mbku(ji,jj) 
     299              ikbv = mbkv(ji,jj) 
     300              ua_btm = zcu(ji,jj) * z2dt_bf * hur(ji,jj) * umask (ji,jj,ikbu) 
     301              va_btm = zcv(ji,jj) * z2dt_bf * hvr(ji,jj) * vmask (ji,jj,ikbv) 
     302 
     303              zua(ji,jj) = zua(ji,jj) - bfrua(ji,jj) * ua_btm 
     304              zva(ji,jj) = zva(ji,jj) - bfrva(ji,jj) * va_btm 
     305           END DO 
     306        END DO 
     307 
     308      ELSE 
     309 
    283310# if defined key_vectopt_loop 
    284       DO jj = 1, 1 
    285          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     311        DO jj = 1, 1 
     312           DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    286313# else 
    287       DO jj = 2, jpjm1 
    288          DO ji = 2, jpim1 
     314        DO jj = 2, jpjm1 
     315           DO ji = 2, jpim1 
    289316# endif 
    290317            ! Apply stability criteria for bottom friction 
    291318            !RBbug for vvl and external mode we may need to use varying fse3 
    292319            !!gm  Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx. 
    293             zbfru(ji,jj) = MAX(  bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef  ) 
    294             zbfrv(ji,jj) = MAX(  bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef  ) 
    295          END DO 
    296       END DO 
    297  
    298       IF( lk_vvl ) THEN 
    299          DO jj = 2, jpjm1 
    300             DO ji = fs_2, fs_jpim1   ! vector opt. 
    301                zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj)   & 
    302                   &       / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1.e0 - umask(ji,jj,1) ) 
    303                zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj)   & 
    304                   &       / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1.e0 - vmask(ji,jj,1) ) 
    305             END DO 
    306          END DO 
    307       ELSE 
    308          DO jj = 2, jpjm1 
    309             DO ji = fs_2, fs_jpim1   ! vector opt. 
    310                zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 
    311                zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 
    312             END DO 
    313          END DO 
    314       ENDIF 
    315  
     320              zbfru(ji,jj) = MAX(  bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef  ) 
     321              zbfrv(ji,jj) = MAX(  bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef  ) 
     322           END DO 
     323        END DO 
     324 
     325        IF( lk_vvl ) THEN 
     326           DO jj = 2, jpjm1 
     327              DO ji = fs_2, fs_jpim1   ! vector opt. 
     328                 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj)   & 
     329                    &       / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1._wp - umask(ji,jj,1) ) 
     330                 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj)   & 
     331                    &       / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1._wp - vmask(ji,jj,1) ) 
     332              END DO 
     333           END DO 
     334        ELSE 
     335           DO jj = 2, jpjm1 
     336              DO ji = fs_2, fs_jpim1   ! vector opt. 
     337                 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 
     338                 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 
     339              END DO 
     340           END DO 
     341        ENDIF 
     342      END IF    ! end (ln_bfrimp) 
     343 
     344                     
    316345      !                                   !* d/dt(Ua), Ub, Vn (Vertical mean velocity) 
    317346      !                                   ! --------------------------  
    … …  
    320349      ! 
    321350      IF( lk_vvl ) THEN 
    322          ub_b(:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) ) 
    323          vb_b(:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) ) 
     351         ub_b(:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 
     352         vb_b(:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
    324353      ELSE 
    325354         ub_b(:,:) = ub_b(:,:) * hur(:,:) 
    … …  
    357386      ! set ssh corrections to 0 
    358387      ! ssh corrections are applied to normal velocities (Flather's algorithm) and averaged over the barotropic loop 
    359       IF( lp_obc_east  )   sshfoe_b(:,:) = 0.e0 
    360       IF( lp_obc_west  )   sshfow_b(:,:) = 0.e0 
    361       IF( lp_obc_south )   sshfos_b(:,:) = 0.e0 
    362       IF( lp_obc_north )   sshfon_b(:,:) = 0.e0 
     388      IF( lp_obc_east  )   sshfoe_b(:,:) = 0._wp 
     389      IF( lp_obc_west  )   sshfow_b(:,:) = 0._wp 
     390      IF( lp_obc_south )   sshfos_b(:,:) = 0._wp 
     391      IF( lp_obc_north )   sshfon_b(:,:) = 0._wp 
    363392#endif 
    364393 
    … …  
    369398         IF( jn == 1 )   z2dt_e = rdt / nn_baro 
    370399 
    371          !                                                !* Update the forcing (OBC, BDY and tides) 
     400         !                                                !* Update the forcing (BDY and tides) 
    372401         !                                                !  ------------------ 
    373402         IF( lk_obc )   CALL obc_dta_bt ( kt, jn   ) 
    374          IF( lk_bdy )   CALL bdy_dta_fla( kt, jn+1, icycle ) 
     403         IF( lk_bdy )   CALL bdy_dta ( kt, jit=jn, time_offset=+1 ) 
    375404         IF ( ln_tide_pot ) CALL upd_tide( kt, jn ) 
    376405 
    377406         !                                                !* after ssh_e 
    378407         !                                                !  ----------- 
    379          DO jj = 2, jpjm1                                      ! Horizontal divergence of barotropic transports 
     408         DO jj = 2, jpjm1                                 ! Horizontal divergence of barotropic transports 
    380409            DO ji = fs_2, fs_jpim1   ! vector opt. 
    381410               zhdiv(ji,jj) = (   e2u(ji  ,jj) * zun_e(ji  ,jj) * hu_e(ji  ,jj)     & 
    … …  
    389418         !                                                     ! OBC : zhdiv must be zero behind the open boundary 
    390419!!  mpp remark: The zeroing of hdiv can probably be extended to 1->jpi/jpj for the correct row/column 
    391          IF( lp_obc_east  )   zhdiv(nie0p1:nie1p1,nje0  :nje1  ) = 0.e0      ! east 
    392          IF( lp_obc_west  )   zhdiv(niw0  :niw1  ,njw0  :njw1  ) = 0.e0      ! west 
    393          IF( lp_obc_north )   zhdiv(nin0  :nin1  ,njn0p1:njn1p1) = 0.e0      ! north 
    394          IF( lp_obc_south )   zhdiv(nis0  :nis1  ,njs0  :njs1  ) = 0.e0      ! south 
     420         IF( lp_obc_east  )   zhdiv(nie0p1:nie1p1,nje0  :nje1  ) = 0._wp      ! east 
     421         IF( lp_obc_west  )   zhdiv(niw0  :niw1  ,njw0  :njw1  ) = 0._wp      ! west 
     422         IF( lp_obc_north )   zhdiv(nin0  :nin1  ,njn0p1:njn1p1) = 0._wp      ! north 
     423         IF( lp_obc_south )   zhdiv(nis0  :nis1  ,njs0  :njs1  ) = 0._wp      ! south 
    395424#endif 
    396425#if defined key_bdy 
    … …  
    406435         !                                                !* after barotropic velocities (vorticity scheme dependent) 
    407436         !                                                !  ---------------------------   
    408          zwx(:,:) = e2u(:,:) * zun_e(:,:) * hu_e(:,:)           ! now_e transport 
     437         zwx(:,:) = e2u(:,:) * zun_e(:,:) * hu_e(:,:)     ! now_e transport 
    409438         zwy(:,:) = e1v(:,:) * zvn_e(:,:) * hv_e(:,:) 
    410439         ! 
    … …  
    435464                  zv_cor =-z1_4 * ( ff(ji-1,jj  ) * zx1 + ff(ji,jj) * zx2 ) * hvr_e(ji,jj) 
    436465                  ! after velocities with implicit bottom friction 
    437                   ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1)   & 
    438                      &         / ( 1.e0         - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 
    439                   va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1)   & 
    440                      &         / ( 1.e0         - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 
     466 
     467                  IF( ln_bfrimp ) THEN      ! implicit bottom friction 
     468                     !   A new method to implement the implicit bottom friction.  
     469                     !   H. Liu 
     470                     !   Sept 2011 
     471                     ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) +                                            & 
     472                      &                               z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp )            & 
     473                      &                               / ( 1._wp      - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 
     474                     ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e *   zua(ji,jj)  ) * umask(ji,jj,1)    
     475                     ! 
     476                     va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) +                                            & 
     477                      &                               z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp )            & 
     478                      &                               / ( 1._wp      - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 
     479                     va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e *   zva(ji,jj)  ) * vmask(ji,jj,1)    
     480                     ! 
     481                  ELSE 
     482                     ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1)   & 
     483                      &           / ( 1._wp         - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 
     484                     va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1)   & 
     485                      &           / ( 1._wp         - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 
     486                  ENDIF 
    441487               END DO 
    442488            END DO 
    … …  
    466512                  zv_cor  = zx1 * ( ff(ji-1,jj  ) + ff(ji,jj) ) * hvr_e(ji,jj) 
    467513                  ! after velocities with implicit bottom friction 
    468                   ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1)   & 
    469                      &         / ( 1.e0         - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 
    470                   va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1)   & 
    471                      &         / ( 1.e0         - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 
     514                  IF( ln_bfrimp ) THEN 
     515                     !   A new method to implement the implicit bottom friction.  
     516                     !   H. Liu 
     517                     !   Sept 2011 
     518                     ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) +                                            & 
     519                      &                               z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp )            & 
     520                      &                               / ( 1._wp      - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 
     521                     ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e *   zua(ji,jj)  ) * umask(ji,jj,1)    
     522                     ! 
     523                     va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) +                                            & 
     524                      &                               z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp )            & 
     525                      &                               / ( 1._wp      - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 
     526                     va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e *   zva(ji,jj)  ) * vmask(ji,jj,1)    
     527                     ! 
     528                  ELSE 
     529                     ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1)   & 
     530                     &            / ( 1._wp        - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 
     531                     va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1)   & 
     532                     &            / ( 1._wp        - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 
     533                  ENDIF 
    472534               END DO 
    473535            END DO 
    … …  
    497559                     &                           + ftnw(ji,jj  ) * zwx(ji-1,jj  ) + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) * hvr_e(ji,jj) 
    498560                  ! after velocities with implicit bottom friction 
    499                   ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1)   & 
    500                      &         / ( 1.e0         - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 
    501                   va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1)   & 
    502                      &         / ( 1.e0         - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 
     561                  IF( ln_bfrimp ) THEN 
     562                     !   A new method to implement the implicit bottom friction.  
     563                     !   H. Liu 
     564                     !   Sept 2011 
     565                     ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) +                                            & 
     566                      &                               z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp )            & 
     567                      &                               / ( 1._wp      - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 
     568                     ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e *   zua(ji,jj)  ) * umask(ji,jj,1)    
     569                     ! 
     570                     va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) +                                            & 
     571                      &                               z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp )            & 
     572                      &                               / ( 1._wp      - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 
     573                     va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e *   zva(ji,jj)  ) * vmask(ji,jj,1)    
     574                     ! 
     575                  ELSE 
     576                     ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1)   & 
     577                     &            / ( 1._wp        - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 
     578                     va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1)   & 
     579                     &            / ( 1._wp        - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 
     580                  ENDIF 
    503581               END DO 
    504582            END DO 
    505583            !  
    506584         ENDIF 
    507          !                                                !* domain lateral boundary 
    508          !                                                !  ----------------------- 
    509          !                                                      ! Flather's boundary condition for the barotropic loop : 
    510          !                                                      !         - Update sea surface height on each open boundary 
    511          !                                                      !         - Correct the velocity 
    512  
     585         !                                                     !* domain lateral boundary 
     586         !                                                     !  ----------------------- 
     587 
     588                                                               ! OBC open boundaries 
    513589         IF( lk_obc               )   CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 
    514          IF( lk_bdy .OR. ln_tides )   CALL bdy_dyn_fla( sshn_e )  
     590 
     591                                                               ! BDY open boundaries 
     592#if defined key_bdy 
     593         pssh => sshn_e 
     594         phur => hur_e 
     595         phvr => hvr_e 
     596         pu2d => ua_e 
     597         pv2d => va_e 
     598 
     599         IF( lk_bdy )   CALL bdy_dyn2d( kt )  
     600#endif 
     601 
    515602         ! 
    516603         CALL lbc_lnk( ua_e  , 'U', -1. )                      ! local domain boundaries  
    … …  
    544631            DO jj = 1, jpjm1                                    ! Sea Surface Height at u- & v-points 
    545632               DO ji = 1, fs_jpim1   ! Vector opt. 
    546                   zsshun_e(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )       & 
    547                      &                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn_e(ji  ,jj)    & 
    548                      &                    + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn_e(ji+1,jj) ) 
    549                   zsshvn_e(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )       & 
    550                      &                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn_e(ji,jj  )    & 
    551                      &                    + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn_e(ji,jj+1) ) 
     633                  zsshun_e(ji,jj) = 0.5_wp * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )       & 
     634                     &                     * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn_e(ji  ,jj)    & 
     635                     &                     +  e1t(ji+1,jj) * e2t(ji+1,jj) * sshn_e(ji+1,jj) ) 
     636                  zsshvn_e(ji,jj) = 0.5_wp * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )       & 
     637                     &                     * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn_e(ji,jj  )    & 
     638                     &                     +  e1t(ji,jj+1) * e2t(ji,jj+1) * sshn_e(ji,jj+1) ) 
    552639               END DO 
    553640            END DO 
    … …  
    557644            hu_e (:,:) = hu_0(:,:) + zsshun_e(:,:)              ! Ocean depth at U- and V-points 
    558645            hv_e (:,:) = hv_0(:,:) + zsshvn_e(:,:) 
    559             hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1.e0 - umask(:,:,1) ) 
    560             hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1.e0 - vmask(:,:,1) ) 
     646            hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1._wp - umask(:,:,1) ) 
     647            hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1._wp - vmask(:,:,1) ) 
    561648            ! 
    562649         ENDIF 
    … …  
    577664      ! 
    578665      !                                   !* Time average ==> after barotropic u, v, ssh 
    579       zcoef =  1.e0 / ( 2 * nn_baro  + 1 )  
     666      zcoef =  1._wp / ( 2 * nn_baro  + 1 )  
    580667      zu_sum(:,:) = zcoef * zu_sum  (:,:)  
    581668      zv_sum(:,:) = zcoef * zv_sum  (:,:)  
    … …  
    583670      !                                   !* update the general momentum trend 
    584671      DO jk=1,jpkm1 
    585          ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) / z2dt_b 
    586          va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) / z2dt_b 
     672         ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b 
     673         va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b 
    587674      END DO 
    588675      un_b  (:,:) =  zu_sum(:,:)  
    … …  
    618705            CALL iom_get( numror, jpdom_autoglo, 'vn_b'  , vn_b  (:,:) )   ! from barotropic loop 
    619706         ELSE 
    620             un_b (:,:) = 0.e0 
    621             vn_b (:,:) = 0.e0 
     707            un_b (:,:) = 0._wp 
     708            vn_b (:,:) = 0._wp 
    622709            ! vertical sum 
    623710            IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll 
    … …  
    640727         ! Vertically integrated velocity (before) 
    641728         IF (neuler/=0) THEN 
    642             ub_b (:,:) = 0.e0 
    643             vb_b (:,:) = 0.e0 
     729            ub_b (:,:) = 0._wp 
     730            vb_b (:,:) = 0._wp 
    644731 
    645732            ! vertical sum 
    … …  
    659746 
    660747            IF( lk_vvl ) THEN 
    661                ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) ) 
    662                vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) ) 
     748               ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 
     749               vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
    663750            ELSE 
    664751               ub_b(:,:) = ub_b(:,:) * hur(:,:) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r2977 r3116  
    2020   USE in_out_manager  ! I/O manager 
    2121   USE lib_mpp         ! MPP library 
     22   USE zdfbfr          ! bottom friction setup 
    2223 
    2324   IMPLICIT NONE 
    … …  
    6162      REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step 
    6263      !! 
    63       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    64       REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
     64      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     65      INTEGER  ::   ikbum1, ikbvm1 ! local variable 
     66      REAL(wp) ::   z1_p2dt, z2dtf, zcoef, zzwi, zzws, zrhs ! local scalars 
     67 
     68      !! * Local variables for implicit bottom friction.    H. Liu 
     69      REAL(wp) ::   zbfru, zbfrv  
     70      REAL(wp) ::   zbfr_imp = 0._wp                        ! toggle (SAVE'd by assignment)  
    6571      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwd, zws 
     72      !!---------------------------------------------------------------------- 
    6673      !!---------------------------------------------------------------------- 
    6774 
    … …  
    7784         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 
    7885         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     86         IF(ln_bfrimp) zbfr_imp = 1._wp 
    7987      ENDIF 
    8088 
    … …  
    8492 
    8593      ! 1. Vertical diffusion on u 
     94 
     95      ! Vertical diffusion on u&v 
    8696      ! --------------------------- 
    8797      ! Matrix and second member construction 
    88       ! bottom boundary condition: both zwi and zws must be masked as avmu can take 
    89       ! non zero value at the ocean bottom depending on the bottom friction 
    90       ! used but the bottom velocities have already been updated with the bottom 
    91       ! friction velocity in dyn_bfr using values from the previous timestep. There 
    92       ! is no need to include these in the implicit calculation. 
    93       ! 
    94       DO jk = 1, jpkm1        ! Matrix 
    95          DO jj = 2, jpjm1  
    96             DO ji = fs_2, fs_jpim1   ! vector opt. 
     98      !! bottom boundary condition: both zwi and zws must be masked as avmu can take 
     99      !! non zero value at the ocean bottom depending on the bottom friction 
     100      !! used but the bottom velocities have already been updated with the bottom 
     101      !! friction velocity in dyn_bfr using values from the previous timestep. There 
     102      !! is no need to include these in the implicit calculation. 
     103 
     104      ! The code has been modified here to implicitly implement bottom 
     105      ! friction: u(v)mask is not necessary here anymore.  
     106      ! H. Liu, April 2010. 
     107 
     108      ! 1. Vertical diffusion on u 
     109      DO jj = 2, jpjm1  
     110         DO ji = fs_2, fs_jpim1   ! vector opt. 
     111            ikbum1 = mbku(ji,jj) 
     112               zbfru = bfrua(ji,jj) 
     113 
     114            DO jk = 1, ikbum1 
    97115               zcoef = - p2dt / fse3u(ji,jj,jk) 
    98                zzwi          = zcoef * avmu (ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
    99                zwi(ji,jj,jk) = zzwi  * umask(ji,jj,jk) 
    100                zzws          = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
    101                zws(ji,jj,jk) = zzws  * umask(ji,jj,jk+1) 
    102                zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws 
    103             END DO 
    104          END DO 
    105       END DO 
    106       DO jj = 2, jpjm1        ! Surface boudary conditions 
    107          DO ji = fs_2, fs_jpim1   ! vector opt. 
     116               zwi(ji,jj,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
     117               zws(ji,jj,jk) = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
     118               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     119            END DO 
     120 
     121      ! Surface boundary conditions 
    108122            zwi(ji,jj,1) = 0._wp 
    109123            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
    110          END DO 
    111       END DO 
     124 
     125      ! Bottom boundary conditions  ! H. Liu, May, 2010 
     126!           !commented out to be consistent with v3.2, h.liu 
     127!           z2dtf = p2dt * zbfru / fse3u(ji,jj,ikbum1) * 2.0_wp * zbfr_imp 
     128            z2dtf = p2dt * zbfru / fse3u(ji,jj,ikbum1) * 1.0_wp * zbfr_imp 
     129            zws(ji,jj,ikbum1) = 0._wp 
     130            zwd(ji,jj,ikbum1) = 1._wp - zwi(ji,jj,ikbum1) - z2dtf  
    112131 
    113132      ! Matrix inversion starting from the first level 
    … …  
    125144      !   The solution (the after velocity) is in ua 
    126145      !----------------------------------------------------------------------- 
    127       ! 
    128       DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    129          DO jj = 2, jpjm1    
    130             DO ji = fs_2, fs_jpim1   ! vector opt. 
     146 
     147      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k) 
     148            DO jk = 2, ikbum1 
    131149               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    132150            END DO 
    133          END DO 
    134       END DO 
    135       ! 
    136       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
    137          DO ji = fs_2, fs_jpim1   ! vector opt. 
    138             ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    139                &                                                       / ( fse3u(ji,jj,1) * rau0       )  ) 
    140          END DO 
    141       END DO 
    142       DO jk = 2, jpkm1 
    143          DO jj = 2, jpjm1    
    144             DO ji = fs_2, fs_jpim1   ! vector opt. 
     151 
     152      ! second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1 
     153            z2dtf = 0.5_wp * p2dt / ( fse3u(ji,jj,1) * rau0 ) 
     154            ua(ji,jj,1) = ub(ji,jj,1) + p2dt * ua(ji,jj,1) + z2dtf * (utau_b(ji,jj) + utau(ji,jj)) 
     155           DO jk = 2, ikbum1    
    145156               zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk)   ! zrhs=right hand side 
    146157               ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 
    147158            END DO 
    148          END DO 
    149       END DO 
    150       ! 
    151       DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  == 
    152          DO ji = fs_2, fs_jpim1   ! vector opt. 
    153             ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
    154          END DO 
    155       END DO 
    156       DO jk = jpk-2, 1, -1 
    157          DO jj = 2, jpjm1    
    158             DO ji = fs_2, fs_jpim1   ! vector opt. 
    159                ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
     159 
     160 
     161      ! third recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk 
     162            ua(ji,jj,ikbum1) = ua(ji,jj,ikbum1) / zwd(ji,jj,ikbum1) 
     163            DO jk = ikbum1-1, 1, -1 
     164               ua(ji,jj,jk) =( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    160165            END DO 
    161166         END DO 
    … …  
    174179      ! 2. Vertical diffusion on v 
    175180      ! --------------------------- 
    176       ! Matrix and second member construction 
    177       ! bottom boundary condition: both zwi and zws must be masked as avmv can take 
    178       ! non zero value at the ocean bottom depending on the bottom friction 
    179       ! used but the bottom velocities have already been updated with the bottom 
    180       ! friction velocity in dyn_bfr using values from the previous timestep. There 
    181       ! is no need to include these in the implicit calculation. 
    182       ! 
    183       DO jk = 1, jpkm1        ! Matrix 
     181 
     182      DO ji = fs_2, fs_jpim1   ! vector opt. 
    184183         DO jj = 2, jpjm1    
    185             DO ji = fs_2, fs_jpim1   ! vector opt. 
     184            ikbvm1 = mbkv(ji,jj) 
     185               zbfrv = bfrva(ji,jj) 
     186 
     187            DO jk = 1, ikbvm1 
    186188               zcoef = -p2dt / fse3v(ji,jj,jk) 
    187                zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  ) 
    188                zwi(ji,jj,jk) =  zzwi * vmask(ji,jj,jk) 
    189                zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 
    190                zws(ji,jj,jk) =  zzws * vmask(ji,jj,jk+1) 
    191                zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws 
    192             END DO 
    193          END DO 
    194       END DO 
    195       DO jj = 2, jpjm1        ! Surface boudary conditions 
    196          DO ji = fs_2, fs_jpim1   ! vector opt. 
     189               zwi(ji,jj,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  ) 
     190               zws(ji,jj,jk) = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 
     191               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     192            END DO 
     193 
     194      ! Surface boundary conditions 
    197195            zwi(ji,jj,1) = 0._wp 
    198196            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
    199          END DO 
    200       END DO 
     197 
     198      ! Bottom boundary conditions  ! H. Liu, May, 2010 
     199!           !commented out to be consistent with v3.2, h.liu 
     200!           z2dtf = p2dt * zbfrv / fse3v(ji,jj,ikbvm1) * 2.0_wp * zbfr_imp 
     201            z2dtf = p2dt * zbfrv / fse3v(ji,jj,ikbvm1) * 1.0_wp * zbfr_imp 
     202            zws(ji,jj,ikbvm1) = 0._wp 
     203            zwd(ji,jj,ikbvm1) = 1._wp - zwi(ji,jj,ikbvm1) - z2dtf  
    201204 
    202205      ! Matrix inversion 
    … …  
    210213      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk ) 
    211214      ! 
    212       !   m is decomposed in the product of an upper and lower triangular matrix 
     215      !   m is decomposed in the product of an upper and lower triangular 
     216      !   matrix 
    213217      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    214218      !   The solution (after velocity) is in 2d array va 
    215219      !----------------------------------------------------------------------- 
    216       ! 
    217       DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    218          DO jj = 2, jpjm1    
    219             DO ji = fs_2, fs_jpim1   ! vector opt. 
     220 
     221      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k) 
     222            DO jk = 2, ikbvm1 
    220223               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    221224            END DO 
    222          END DO 
    223       END DO 
    224       ! 
    225       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  == 
    226          DO ji = fs_2, fs_jpim1   ! vector opt. 
    227             va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    228                &                                                       / ( fse3v(ji,jj,1) * rau0       )  ) 
    229          END DO 
    230       END DO 
    231       DO jk = 2, jpkm1 
    232          DO jj = 2, jpjm1 
    233             DO ji = fs_2, fs_jpim1   ! vector opt. 
     225 
     226      ! second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1 
     227            z2dtf = 0.5_wp * p2dt / ( fse3v(ji,jj,1)*rau0 ) 
     228            va(ji,jj,1) = vb(ji,jj,1) + p2dt * va(ji,jj,1) + z2dtf * (vtau_b(ji,jj) + vtau(ji,jj)) 
     229            DO jk = 2, ikbvm1 
    234230               zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk)   ! zrhs=right hand side 
    235231               va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 
    236232            END DO 
    237          END DO 
    238       END DO 
    239       ! 
    240       DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  == 
    241          DO ji = fs_2, fs_jpim1   ! vector opt. 
    242             va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
    243          END DO 
    244       END DO 
    245       DO jk = jpk-2, 1, -1 
    246          DO jj = 2, jpjm1    
    247             DO ji = fs_2, fs_jpim1   ! vector opt. 
    248                va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    249             END DO 
     233 
     234      ! third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk 
     235            va(ji,jj,ikbvm1) = va(ji,jj,ikbvm1) / zwd(ji,jj,ikbvm1) 
     236 
     237            DO jk = ikbvm1-1, 1, -1 
     238               va(ji,jj,jk) =( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
     239            END DO 
     240 
    250241         END DO 
    251242      END DO 
    … …  
    262253      IF( wrk_not_released(3, 3) )   CALL ctl_stop('dyn_zdf_imp: failed to release workspace array') 
    263254      ! 
     255 
    264256   END SUBROUTINE dyn_zdf_imp 
    265257 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2977 r3116  
    183183#if defined key_bdy 
    184184      ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    185       CALL lbc_lnk( ssha, 'T', 1. )  
     185      CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    186186#endif 
    187187 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r2715 r3116  
    55   !!====================================================================== 
    66   !! History :  9.0  !  05-07  (C. Talandier) original code 
     7   !!            3.4  !  11-11  (C. Harris) decomposition changes for running with CICE 
    78   !!---------------------------------------------------------------------- 
    89   USE dom_oce          ! ocean space and time domain variables 
    … …  
    434435 
    435436      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
     437#if defined key_nemocice_decomp 
     438      ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj  
     439#else 
    436440      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
     441#endif 
    437442 
    438443      ALLOCATE(ilcitl (isplt,jsplt)) 
    … …  
    445450 
    446451      IF(  irestil == 0 )   irestil = isplt 
     452#if defined key_nemocice_decomp 
     453 
     454      ! In order to match CICE the size of domains in NEMO has to be changed 
     455      ! The last line of blocks (west) will have fewer points  
     456      DO jj = 1, jsplt  
     457         DO ji=1, isplt-1  
     458            ilcitl(ji,jj) = ijpi  
     459         END DO  
     460         ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 
     461      END DO  
     462 
     463#else  
     464 
    447465      DO jj = 1, jsplt 
    448466         DO ji = 1, irestil 
    … …  
    453471         END DO 
    454472      END DO 
     473 
     474#endif 
    455475       
    456476      IF( irestjl == 0 )   irestjl = jsplt 
     477#if defined key_nemocice_decomp  
     478 
     479      ! Same change to domains in North-South direction as in East-West.  
     480      DO ji = 1, isplt  
     481         DO jj=1, jsplt-1  
     482            ilcjtl(ji,jj) = ijpj  
     483         END DO  
     484         ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 
     485      END DO  
     486 
     487#else  
     488 
    457489      DO ji = 1, isplt 
    458490         DO jj = 1, irestjl 
    … …  
    463495         END DO 
    464496      END DO 
    465        
     497 
     498#endif 
    466499      zidom = nrecil 
    467500      DO ji = 1, isplt 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r2715 r3116  
    236236               END DO 
    237237            END DO 
     238         CASE ( 'J' )                                     ! first ice U-V point 
     239            DO jl =0, ipr2dj 
     240               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 
     241               DO ji = 3, jpiglo 
     242                  iju = jpiglo - ji + 3 
     243                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 
     244               END DO 
     245            END DO 
     246         CASE ( 'K' )                                     ! second ice U-V point 
     247            DO jl =0, ipr2dj 
     248               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 
     249               DO ji = 3, jpiglo 
     250                  iju = jpiglo - ji + 3 
     251                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 
     252               END DO 
     253            END DO 
    238254         END SELECT 
    239255         ! 
    … …  
    285301               END DO 
    286302            END DO 
     303         CASE ( 'J' )                                  ! first ice U-V point 
     304            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 
     305            DO jl = 0, ipr2dj 
     306               DO ji = 2 , jpiglo-1 
     307                  ijt = jpiglo - ji + 2 
     308                  pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl) 
     309               END DO 
     310            END DO 
     311         CASE ( 'K' )                                  ! second ice U-V point 
     312            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 
     313            DO jl = 0, ipr2dj 
     314               DO ji = 2 , jpiglo-1 
     315                  ijt = jpiglo - ji + 2 
     316                  pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl) 
     317               END DO 
     318            END DO 
    287319         END SELECT 
    288320         ! 
    … …  
    298330            pt2d(:, 1:1-ipr2dj     ) = 0.e0 
    299331            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
     332         CASE ( 'J' )                                   ! first ice U-V point 
     333            pt2d(:, 1:1-ipr2dj     ) = 0.e0 
     334            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
     335         CASE ( 'K' )                                   ! second ice U-V point 
     336            pt2d(:, 1:1-ipr2dj     ) = 0.e0 
     337            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
    300338         END SELECT 
    301339         ! 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2731 r3116  
    164164   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztab, znorthloc 
    165165   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   znorthgloio 
     166   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   zfoldwk      ! Workspace for message transfers avoiding mpi_allgather 
    166167 
    167168   ! Arrays used in mpp_lbc_north_2d() 
    168169   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_2d, znorthloc_2d 
    169170   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_2d 
     171   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   zfoldwk_2d    ! Workspace for message transfers avoiding mpi_allgather 
    170172 
    171173   ! Arrays used in mpp_lbc_north_e() 
    … …  
    173175   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_e 
    174176 
     177   ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 
     178   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  
     180   INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto 
     181   INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto 
     182   LOGICAL, PUBLIC                                  ::   ln_nnogather     = .FALSE.  ! namelist control of northfold comms 
     183   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms 
     184   INTEGER, PUBLIC                                  ::   ityp 
    175185   !!---------------------------------------------------------------------- 
    176186   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    203213         ! 
    204214         &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        & 
     215         &      zfoldwk(jpi,4,jpk) ,                                                                             & 
    205216         ! 
    206217         &      ztab_2d(jpiglo,4)  , znorthloc_2d(jpi,4)  , znorthgloio_2d(jpi,4,jpni)  ,                        & 
     218         &      zfoldwk_2d(jpi,4)  ,                                                                             & 
    207219         ! 
    208220         &      ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   & 
    … …  
    232244      LOGICAL ::   mpi_was_called 
    233245      ! 
    234       NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij 
     246      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather 
    235247      !!---------------------------------------------------------------------- 
    236248      ! 
    … …  
    269281         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij; ii = ii +1 
    270282      END IF 
     283 
     284      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1 
    271285 
    272286      CALL mpi_initialized ( mpi_was_called, code ) 
    … …  
    441455      CASE ( -1 ) 
    442456         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 
    443          CALL mpprecv( 1, t3ew(1,1,1,2), imigr ) 
     457         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 
    444458         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    445459      CASE ( 0 ) 
    446460         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    447461         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 ) 
    448          CALL mpprecv( 1, t3ew(1,1,1,2), imigr ) 
    449          CALL mpprecv( 2, t3we(1,1,1,2), imigr ) 
     462         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 
     463         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 
    450464         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    451465         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    452466      CASE ( 1 ) 
    453467         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    454          CALL mpprecv( 2, t3we(1,1,1,2), imigr ) 
     468         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 
    455469         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    456470      END SELECT 
    … …  
    494508      CASE ( -1 ) 
    495509         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    496          CALL mpprecv( 3, t3ns(1,1,1,2), imigr ) 
     510         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 
    497511         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    498512      CASE ( 0 ) 
    499513         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    500514         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 ) 
    501          CALL mpprecv( 3, t3ns(1,1,1,2), imigr ) 
    502          CALL mpprecv( 4, t3sn(1,1,1,2), imigr ) 
     515         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 
     516         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
    503517         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    504518         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    505519      CASE ( 1 )  
    506520         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    507          CALL mpprecv( 4, t3sn(1,1,1,2), imigr ) 
     521         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
    508522         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    509523      END SELECT 
    … …  
    635649      CASE ( -1 ) 
    636650         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 
    637          CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
     651         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
    638652         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    639653      CASE ( 0 ) 
    640654         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    641655         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 
    642          CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
    643          CALL mpprecv( 2, t2we(1,1,2), imigr ) 
     656         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
     657         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
    644658         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    645659         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    646660      CASE ( 1 ) 
    647661         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    648          CALL mpprecv( 2, t2we(1,1,2), imigr ) 
     662         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
    649663         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    650664      END SELECT 
    … …  
    688702      CASE ( -1 ) 
    689703         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 
    690          CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
     704         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
    691705         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    692706      CASE ( 0 ) 
    693707         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    694708         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 
    695          CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
    696          CALL mpprecv( 4, t2sn(1,1,2), imigr ) 
     709         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
     710         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
    697711         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    698712         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    699713      CASE ( 1 ) 
    700714         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    701          CALL mpprecv( 4, t2sn(1,1,2), imigr ) 
     715         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
    702716         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    703717      END SELECT 
    … …  
    816830      CASE ( -1 ) 
    817831         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 
    818          CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr ) 
     832         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea ) 
    819833         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    820834      CASE ( 0 ) 
    821835         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
    822836         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 ) 
    823          CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr ) 
    824          CALL mpprecv( 2, t4we(1,1,1,1,2), imigr ) 
     837         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea ) 
     838         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe ) 
    825839         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    826840         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    827841      CASE ( 1 ) 
    828842         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
    829          CALL mpprecv( 2, t4we(1,1,1,1,2), imigr ) 
     843         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe ) 
    830844         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    831845      END SELECT 
    … …  
    875889      CASE ( -1 ) 
    876890         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 
    877          CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr ) 
     891         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono ) 
    878892         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    879893      CASE ( 0 ) 
    880894         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
    881895         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 
    882          CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr ) 
    883          CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr ) 
     896         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono ) 
     897         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 
    884898         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    885899         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    886900      CASE ( 1 )  
    887901         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
    888          CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr ) 
     902         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 
    889903         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    890904      END SELECT 
    … …  
    10191033      CASE ( -1 ) 
    10201034         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 ) 
    1021          CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr ) 
     1035         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 
    10221036         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10231037      CASE ( 0 ) 
    10241038         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 
    10251039         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 ) 
    1026          CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr ) 
    1027          CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr ) 
     1040         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 
     1041         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 
    10281042         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10291043         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    10301044      CASE ( 1 ) 
    10311045         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 
    1032          CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr ) 
     1046         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 
    10331047         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10341048      END SELECT 
    … …  
    10721086      CASE ( -1 ) 
    10731087         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 ) 
    1074          CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr ) 
     1088         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 
    10751089         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10761090      CASE ( 0 ) 
    10771091         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 
    10781092         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 ) 
    1079          CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr ) 
    1080          CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr ) 
     1093         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 
     1094         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 
    10811095         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10821096         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    10831097      CASE ( 1 ) 
    10841098         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 
    1085          CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr ) 
     1099         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 
    10861100         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    10871101      END SELECT 
    … …  
    11381152 
    11391153 
    1140    SUBROUTINE mpprecv( ktyp, pmess, kbytes ) 
     1154   SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource ) 
    11411155      !!---------------------------------------------------------------------- 
    11421156      !!                  ***  routine mpprecv  *** 
    … …  
    11481162      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess 
    11491163      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message 
     1164      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number  
    11501165      !! 
    11511166      INTEGER :: istatus(mpi_status_size) 
    11521167      INTEGER :: iflag 
    1153       !!---------------------------------------------------------------------- 
    1154       ! 
    1155       CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag ) 
     1168      INTEGER :: use_source 
     1169      !!---------------------------------------------------------------------- 
     1170      ! 
     1171 
     1172      ! If a specific process number has been passed to the receive call,  
     1173      ! use that one. Default is to use mpi_any_source 
     1174      use_source=mpi_any_source 
     1175      if(present(ksource)) then 
     1176         use_source=ksource 
     1177      end if 
     1178 
     1179      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag ) 
    11561180      ! 
    11571181   END SUBROUTINE mpprecv 
    … …  
    18331857         IF( nbondi == -1 ) THEN 
    18341858            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 
    1835             CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
     1859            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
    18361860            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    18371861         ELSEIF( nbondi == 0 ) THEN 
    18381862            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    18391863            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 
    1840             CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
    1841             CALL mpprecv( 2, t2we(1,1,2), imigr ) 
     1864            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
     1865            CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
    18421866            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    18431867            IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    18441868         ELSEIF( nbondi == 1 ) THEN 
    18451869            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1846             CALL mpprecv( 2, t2we(1,1,2), imigr ) 
     1870            CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
    18471871            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    18481872         ENDIF 
    … …  
    18791903         IF( nbondj == -1 ) THEN 
    18801904            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 
    1881             CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
     1905            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
    18821906            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    18831907         ELSEIF( nbondj == 0 ) THEN 
    18841908            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    18851909            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 
    1886             CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
    1887             CALL mpprecv( 4, t2sn(1,1,2), imigr ) 
     1910            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
     1911            CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
    18881912            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    18891913            IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    18901914         ELSEIF( nbondj == 1 ) THEN 
    18911915            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    1892             CALL mpprecv( 4, t2sn(1,1,2), imigr) 
     1916            CALL mpprecv( 4, t2sn(1,1,2), imigr, noso) 
    18931917            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    18941918         ENDIF 
    … …  
    22092233      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    22102234      INTEGER ::   ijpj, ijpjm1, ij, iproc 
     2235      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          ! for mpi_isend when avoiding mpi_allgather 
     2236      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
     2237      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    22112238      !!---------------------------------------------------------------------- 
    22122239      !    
    22132240      ijpj   = 4 
     2241      ityp = -1 
    22142242      ijpjm1 = 3 
    22152243      ztab(:,:,:) = 0.e0 
    … …  
    22222250      !                                     ! Build in procs of ncomm_north the znorthgloio 
    22232251      itaille = jpi * jpk * ijpj 
    2224       CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                & 
    2225          &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    2226       ! 
    2227       !                                     ! recover the global north array 
    2228       DO jr = 1, ndim_rank_north 
    2229          iproc = nrank_north(jr) + 1 
    2230          ildi  = nldit (iproc) 
    2231          ilei  = nleit (iproc) 
    2232          iilb  = nimppt(iproc) 
    2233          DO jj = 1, 4 
    2234             DO ji = ildi, ilei 
    2235                ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 
     2252      IF ( l_north_nogather ) THEN 
     2253         ! 
     2254         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2255         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
     2256         ! 
     2257         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
     2258            ij = jj - nlcj + ijpj 
     2259            DO ji = 1, nlci 
     2260               ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 
    22362261            END DO 
    22372262         END DO 
    2238       END DO 
     2263 
     2264         ! 
     2265         ! Set the exchange type in order to access the correct list of active neighbours 
     2266         ! 
     2267         SELECT CASE ( cd_type ) 
     2268            CASE ( 'T' , 'W' ) 
     2269               ityp = 1 
     2270            CASE ( 'U' ) 
     2271               ityp = 2 
     2272            CASE ( 'V' ) 
     2273               ityp = 3 
     2274            CASE ( 'F' ) 
     2275               ityp = 4 
     2276            CASE ( 'I' ) 
     2277               ityp = 5 
     2278            CASE DEFAULT 
     2279               ityp = -1                    ! Set a default value for unsupported types which  
     2280                                            ! will cause a fallback to the mpi_allgather method 
     2281         END SELECT 
     2282         IF ( ityp .gt. 0 ) THEN 
     2283 
     2284            DO jr = 1,nsndto(ityp) 
     2285               CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 
     2286            END DO 
     2287            DO jr = 1,nsndto(ityp) 
     2288               CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 
     2289               iproc = isendto(jr,ityp) + 1 
     2290               ildi = nldit (iproc) 
     2291               ilei = nleit (iproc) 
     2292               iilb = nimppt(iproc) 
     2293               DO jj = 1, ijpj 
     2294                  DO ji = ildi, ilei 
     2295                     ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 
     2296                  END DO 
     2297               END DO 
     2298            END DO 
     2299            IF (l_isend) THEN 
     2300               DO jr = 1,nsndto(ityp) 
     2301                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2302               END DO 
     2303            ENDIF 
     2304 
     2305         ENDIF 
     2306 
     2307      ENDIF 
     2308 
     2309      IF ( ityp .lt. 0 ) THEN 
     2310         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                & 
     2311            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2312         ! 
     2313         DO jr = 1, ndim_rank_north         ! recover the global north array 
     2314            iproc = nrank_north(jr) + 1 
     2315            ildi  = nldit (iproc) 
     2316            ilei  = nleit (iproc) 
     2317            iilb  = nimppt(iproc) 
     2318            DO jj = 1, ijpj 
     2319               DO ji = ildi, ilei 
     2320                  ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 
     2321               END DO 
     2322            END DO 
     2323         END DO 
     2324      ENDIF 
     2325      ! 
     2326      ! The ztab array has been either: 
     2327      !  a. Fully populated by the mpi_allgather operation or 
     2328      !  b. Had the active points for this domain and northern neighbours populated  
     2329      !     by peer to peer exchanges 
     2330      ! Either way the array may be folded by lbc_nfd and the result for the span of  
     2331      ! this domain will be identical. 
    22392332      ! 
    22402333      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition 
    … …  
    22722365      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    22732366      INTEGER ::   ijpj, ijpjm1, ij, iproc 
     2367      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          ! for mpi_isend when avoiding mpi_allgather 
     2368      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
     2369      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    22742370      !!---------------------------------------------------------------------- 
    22752371      ! 
    22762372      ijpj   = 4 
     2373      ityp = -1 
    22772374      ijpjm1 = 3 
    22782375      ztab_2d(:,:) = 0.e0 
    … …  
    22852382      !                                     ! Build in procs of ncomm_north the znorthgloio_2d 
    22862383      itaille = jpi * ijpj 
    2287       CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        & 
    2288          &                znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    2289       ! 
    2290       DO jr = 1, ndim_rank_north            ! recover the global north array 
    2291          iproc = nrank_north(jr) + 1 
    2292          ildi=nldit (iproc) 
    2293          ilei=nleit (iproc) 
    2294          iilb=nimppt(iproc) 
    2295          DO jj = 1, 4 
    2296             DO ji = ildi, ilei 
    2297                ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 
     2384      IF ( l_north_nogather ) THEN 
     2385         ! 
     2386         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2387         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
     2388         ! 
     2389         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
     2390            ij = jj - nlcj + ijpj 
     2391            DO ji = 1, nlci 
     2392               ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 
    22982393            END DO 
    22992394         END DO 
    2300       END DO 
     2395 
     2396         ! 
     2397         ! Set the exchange type in order to access the correct list of active neighbours 
     2398         ! 
     2399         SELECT CASE ( cd_type ) 
     2400            CASE ( 'T' , 'W' ) 
     2401               ityp = 1 
     2402            CASE ( 'U' ) 
     2403               ityp = 2 
     2404            CASE ( 'V' ) 
     2405               ityp = 3 
     2406            CASE ( 'F' ) 
     2407               ityp = 4 
     2408            CASE ( 'I' ) 
     2409               ityp = 5 
     2410            CASE DEFAULT 
     2411               ityp = -1                    ! Set a default value for unsupported types which  
     2412                                            ! will cause a fallback to the mpi_allgather method 
     2413         END SELECT 
     2414 
     2415         IF ( ityp .gt. 0 ) THEN 
     2416 
     2417            DO jr = 1,nsndto(ityp) 
     2418               CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 
     2419            END DO 
     2420            DO jr = 1,nsndto(ityp) 
     2421               CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp)) 
     2422               iproc = isendto(jr,ityp) + 1 
     2423               ildi = nldit (iproc) 
     2424               ilei = nleit (iproc) 
     2425               iilb = nimppt(iproc) 
     2426               DO jj = 1, ijpj 
     2427                  DO ji = ildi, ilei 
     2428                     ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj) 
     2429                  END DO 
     2430               END DO 
     2431            END DO 
     2432            IF (l_isend) THEN 
     2433               DO jr = 1,nsndto(ityp) 
     2434                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2435               END DO 
     2436            ENDIF 
     2437 
     2438         ENDIF 
     2439 
     2440      ENDIF 
     2441 
     2442      IF ( ityp .lt. 0 ) THEN 
     2443         CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        & 
     2444            &                znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2445         ! 
     2446         DO jr = 1, ndim_rank_north            ! recover the global north array 
     2447            iproc = nrank_north(jr) + 1 
     2448            ildi = nldit (iproc) 
     2449            ilei = nleit (iproc) 
     2450            iilb = nimppt(iproc) 
     2451            DO jj = 1, ijpj 
     2452               DO ji = ildi, ilei 
     2453                  ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 
     2454               END DO 
     2455            END DO 
     2456         END DO 
     2457      ENDIF 
     2458      ! 
     2459      ! The ztab array has been either: 
     2460      !  a. Fully populated by the mpi_allgather operation or 
     2461      !  b. Had the active points for this domain and northern neighbours populated  
     2462      !     by peer to peer exchanges 
     2463      ! Either way the array may be folded by lbc_nfd and the result for the span of  
     2464      ! this domain will be identical. 
    23012465      ! 
    23022466      CALL lbc_nfd( ztab_2d, cd_type, psgn )   ! North fold boundary condition 
    … …  
    24992663 
    25002664   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag 
     2665   LOGICAL, PUBLIC            ::   ln_nnogather  = .FALSE.  !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 
    25012666   INTEGER :: ncomm_ice 
    25022667   !!---------------------------------------------------------------------- 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r2715 r3116  
    125125      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    126126      !!   8.5  !  02-08  (G. Madec)  F90 : free form 
     127      !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE 
    127128      !!---------------------------------------------------------------------- 
    128129      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    … …  
    152153 
    153154      IF(  iresti == 0 )   iresti = jpni 
     155 
     156#if defined key_nemocice_decomp 
     157      ! In order to match CICE the size of domains in NEMO has to be changed 
     158      ! The last line of blocks (west) will have fewer points 
     159 
     160      DO jj = 1, jpnj 
     161         DO ji=1, jpni-1 
     162            ilcit(ji,jj) = jpi 
     163         END DO 
     164         ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci) 
     165      END DO 
     166 
     167#else 
     168 
    154169      DO jj = 1, jpnj 
    155170         DO ji = 1, iresti 
    … …  
    161176      END DO 
    162177       
     178#endif 
    163179      IF( irestj == 0 )   irestj = jpnj 
     180 
     181#if defined key_nemocice_decomp 
     182      ! Same change to domains in North-South direction as in East-West.  
     183      DO ji=1,jpni 
     184         DO jj=1,jpnj-1 
     185            ilcjt(ji,jj) = jpj 
     186         END DO 
     187         ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 
     188      END DO 
     189 
     190#else 
     191 
    164192      DO ji = 1, jpni 
    165193         DO jj = 1, irestj 
    … …  
    171199      END DO 
    172200       
     201#endif 
    173202      IF(lwp) THEN 
    174203         WRITE(numout,*) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2977 r3116  
    4646   !                                                                !! Griffies operator 
    4747   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells 
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials  
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials 
    4949   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate 
    5050 
    … …  
    5858 
    5959   ! Workspace arrays for ldf_slp_grif. These could be replaced by several 3D and 2D workspace 
    60    ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace  
     60   ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace 
    6161   ! arrays can't be used here because of the zero-indexing of some of the ranks. ARPDBG. 
    6262   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zdzrho , zdyrho, zdxrho     ! Horizontal and vertical density gradients 
    … …  
    9393      !!---------------------------------------------------------------------- 
    9494      !!                 ***  ROUTINE ldf_slp  *** 
    95       !!  
     95      !! 
    9696      !! ** Purpose :   Compute the slopes of neutral surface (slope of isopycnal 
    9797      !!              surfaces referenced locally) (ln_traldf_iso=T). 
    98       !!  
    99       !! ** Method  :   The slope in the i-direction is computed at U- and  
    100       !!      W-points (uslp, wslpi) and the slope in the j-direction is  
     98      !! 
     99      !! ** Method  :   The slope in the i-direction is computed at U- and 
     100      !!      W-points (uslp, wslpi) and the slope in the j-direction is 
    101101      !!      computed at V- and W-points (vslp, wslpj). 
    102102      !!      They are bounded by 1/100 over the whole ocean, and within the 
    … …  
    112112      !!      bottom slope (ln_sco=T) at level jpk in inildf] 
    113113      !! 
    114       !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes  
     114      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes 
    115115      !!               of now neutral surfaces at u-, w- and v- w-points, resp. 
    116116      !!---------------------------------------------------------------------- 
    … …  
    127127      INTEGER  ::   ii0, ii1, iku   ! temporary integer 
    128128      INTEGER  ::   ij0, ij1, ikv   ! temporary integer 
    129       REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16    ! local scalars 
     129      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars 
    130130      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    131131      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    … …  
    152152         DO jj = 1, jpjm1 
    153153            DO ji = 1, fs_jpim1   ! vector opt. 
    154                zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )  
    155                zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )  
     154               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
     155               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
    156156            END DO 
    157157         END DO 
    158158      END DO 
    159159      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    160 # if defined key_vectopt_loop   
     160# if defined key_vectopt_loop 
    161161         DO jj = 1, 1 
    162162            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    165165            DO ji = 1, jpim1 
    166166# endif 
    167                zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)  
    168                zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)                
     167               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
     168               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
    169169            END DO 
    170170         END DO 
    … …  
    185185      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
    186186 
    187        
     187 
    188188      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd ) 
    189189      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
    190       !                
     190      ! 
    191191      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    192192         DO jj = 2, jpjm1 
    … …  
    229229      DO jk = 2, jpkm1 
    230230         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    231             DO ji = 2, jpim1   
     231            DO ji = 2, jpim1 
    232232               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    233233                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
    … …  
    270270      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd ) 
    271271      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    272       !                
     272      ! 
    273273      DO jk = 2, jpkm1 
    274274         DO jj = 2, jpjm1 
    … …  
    312312         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    313313            DO ji = 2, jpim1 
     314               zcofw = tmask(ji,jj,jk) * z1_16 
    314315               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    315                   &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    316                   &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    317                   &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    318                   &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk) 
     316                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
     317                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
     318                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
     319                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
    319320 
    320321               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
    321                   &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
    322                   &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    323                   &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    324                   &                + 4.*  zww(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk) 
    325             END DO 
    326          END DO   
     322                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
     323                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
     324                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
     325                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
     326            END DO 
     327         END DO 
    327328         DO jj = 3, jpj-2                               ! other rows 
    328329            DO ji = fs_2, fs_jpim1   ! vector opt. 
     330               zcofw = tmask(ji,jj,jk) * z1_16 
    329331               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    330                   &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    331                   &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    332                   &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    333                   &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk) 
     332                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
     333                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
     334                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
     335                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
    334336 
    335337               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
    336                   &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
    337                   &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    338                   &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    339                   &                + 4.*  zww(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk) 
     338                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
     339                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
     340                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
     341                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
    340342            END DO 
    341343         END DO 
    … …  
    350352         END DO 
    351353      END DO 
    352           
    353       ! III.  Specific grid points      
    354       ! ===========================  
    355       !                
     354 
     355      ! III.  Specific grid points 
     356      ! =========================== 
     357      ! 
    356358      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area 
    357359         !                                                    ! Gibraltar Strait 
    … …  
    372374      ENDIF 
    373375 
    374       ! IV. Lateral boundary conditions  
     376 
     377      ! IV. Lateral boundary conditions 
    375378      ! =============================== 
    376379      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    … …  
    386389      ! 
    387390   END SUBROUTINE ldf_slp 
    388     
     391 
    389392 
    390393   SUBROUTINE ldf_slp_grif ( kt ) 
    … …  
    394397      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope 
    395398      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T) 
    396       !!      at W-points using the Griffies quarter-cells.   
    397       !! 
    398       !! ** Method  :   calculates alpha and beta at T-points  
     399      !!      at W-points using the Griffies quarter-cells. 
     400      !! 
     401      !! ** Method  :   calculates alpha and beta at T-points 
    399402      !! 
    400403      !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv) 
    … …  
    403406      !!---------------------------------------------------------------------- 
    404407      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     408      USE oce     , ONLY:   zalbet  => ua       ! use ua as workspace 
    405409      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1 
    406       USE wrk_nemo, ONLY:   zalpha  => wrk_3d_2 , zbeta => wrk_3d_3    ! alpha, beta at T points, at depth fsgdept 
    407       USE wrk_nemo, ONLY:   zdits   => wrk_4d_1 , zdjts => wrk_4d_2, zdkts => wrk_4d_3   ! 4D workspace 
    408       !! 
    409       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    410       !! 
    411       INTEGER  ::   ji, jj, jk, jn, jl, ip, jp, kp  ! dummy loop indices 
    412       INTEGER  ::   iku, ikv                                  ! local integer 
    413       REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars 
    414       REAL(wp) ::   zbu, zbv, zbti, zbtj                      !   -      - 
    415       REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim 
    416       REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 
     410      !! 
     411      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
     412      !! 
     413      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
     414      INTEGER  ::   iku, ikv                    ! local integer 
     415      REAL(wp) ::   zfacti, zfactj              ! local scalars 
     416      REAL(wp) ::   znot_thru_surface           ! local scalars 
     417      REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj 
     418      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim 
     419      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 
    417420      REAL(wp) ::   zdzrho_raw 
     421      REAL(wp) ::   zbeta0 
    418422      !!---------------------------------------------------------------------- 
    419423 
    … …  
    426430      !--------------------------------! 
    427431      ! 
    428       CALL eos_alpbet( tsb, zalpha, zbeta )     !==  before thermal and haline expension coeff. at T-points  ==! 
    429       ! 
    430       DO jn = 1, jpts 
    431          DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
    432             DO jj = 1, jpjm1 
    433                DO ji = 1, fs_jpim1   ! vector opt. 
    434                   zdits(ji,jj,jk,jn) = ( tsb(ji+1,jj,jk,jn) - tsb(ji,jj,jk,jn) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj 
    435                   zdjts(ji,jj,jk,jn) = ( tsb(ji,jj+1,jk,jn) - tsb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)   ! j-gradient of T and S at jj 
     432      CALL eos_alpbet( tsb, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==! 
     433      ! 
     434      DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
     435         ! 
     436         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln) 
     437         DO jk = 1, jpkm1                     ! done each pair of triad 
     438            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set 
     439               DO ji = 1, fs_jpim1            ! vector opt. 
     440                  zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point 
     441                  zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
     442                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
     443                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
     444                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
     445                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
     446                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
     447                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    436448               END DO 
    437449            END DO 
    438450         END DO 
    439          IF( ln_zps ) THEN                               ! partial steps: correction at the last level 
     451         ! 
     452         IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    440453# if defined key_vectopt_loop 
    441454            DO jj = 1, 1 
    442                DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     455               DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling) 
    443456# else 
    444457            DO jj = 1, jpjm1 
    445458               DO ji = 1, jpim1 
    446459# endif 
    447                   zdits(ji,jj,mbku(ji,jj),jn) = gtsu(ji,jj,jn)                           ! i-gradient of T and S 
    448                   zdjts(ji,jj,mbkv(ji,jj),jn) = gtsv(ji,jj,jn)                           ! j-gradient of T and S 
     460                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
     461                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
     462                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity 
     463                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
     464                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
     465                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
     466                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    449467               END DO 
    450468            END DO 
    451469         ENDIF 
    452470         ! 
    453          zdkts(:,:,1,jn) = 0._wp                    !==  before vertical T & S gradient at w-level  ==! 
    454          DO jk = 2, jpk 
    455             zdkts(:,:,jk,jn) = ( tsb(:,:,jk-1,jn) - tsb(:,:,jk,jn) ) * tmask(:,:,jk) 
    456          END DO 
    457          ! 
    458       END DO  
    459       ! 
    460       DO jl = 0, 1                           !==  density i-, j-, and k-gradients  ==! 
    461          ip = jl   ;   jp = jl         ! guaranteed nonzero gradients ( absolute value larger than repsln) 
    462          DO jk = 1, jpkm1                          ! done each pair of triad 
    463             DO jj = 1, jpjm1                       ! NB: not masked due to the minimum value set 
    464                DO ji = 1, fs_jpim1   ! vector opt.  
    465                   zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdits(ji,jj,jk,jp_tem) + zbeta(ji+ip,jj   ,jk) * zdits(ji,jj,jk,jp_sal) ) / e1u(ji,jj) 
    466                   zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjts(ji,jj,jk,jp_tem) + zbeta(ji   ,jj+jp,jk) * zdjts(ji,jj,jk,jp_sal) ) / e2v(ji,jj) 
    467                   zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )    ! keep the sign 
    468                   zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX(   repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    469                END DO 
    470             END DO 
    471          END DO 
    472       END DO 
    473      DO kp = 0, 1                           !==  density i-, j-, and k-gradients  ==! 
    474          DO jk = 1, jpkm1                          ! done each pair of triad 
    475             DO jj = 1, jpj                       ! NB: not masked due to the minimum value set 
    476                DO ji = 1, jpi   ! vector opt.  
    477                   zdzrho_raw = ( zalpha(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_tem) + zbeta(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_sal) )   & 
    478                      &       / fse3w(ji,jj,jk+kp) 
    479                   zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )                    ! force zdzrho >= repsln 
    480                END DO 
    481             END DO 
    482          END DO 
    483       END DO 
    484       ! 
    485       DO jj = 1, jpj                         !==  Reciprocal depth of the w-point below ML base  ==! 
     471      END DO 
     472 
     473      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
     474         DO jk = 1, jpkm1                     ! done each pair of triad 
     475            DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set 
     476               DO ji = 1, jpi                 ! vector opt. 
     477                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp 
     478                     zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) ) 
     479                     zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) ) 
     480                  ELSE 
     481                     zdkt = 0._wp                                             ! 1st level gradient set to zero 
     482                     zdks = 0._wp 
     483                  ENDIF 
     484                  zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
     485                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln 
     486                 END DO 
     487            END DO 
     488         END DO 
     489      END DO 
     490      ! 
     491      DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==! 
    486492         DO ji = 1, jpi 
    487493            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    … …  
    490496      END DO 
    491497      ! 
    492       !                                      !==  intialisations to zero  ==! 
    493       ! 
    494       wslp2  (:,:,:)     = 0._wp                                           ! wslp2 will be cumulated 3D field set to zero 
    495       triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp      ! set surface and bottom slope to zero 
     498      !                                       !==  intialisations to zero  ==! 
     499      ! 
     500      wslp2  (:,:,:)     = 0._wp              ! wslp2 will be cumulated 3D field set to zero 
     501      triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero 
    496502      triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp 
    497 !!gm _iso set to zero missing 
    498       triadi (:,:,1,:,:) = 0._wp   ;   triadj (:,:,jpk,:,:) = 0._wp        ! set surface and bottom slope to zero 
    499       triadj (:,:,1,:,:) = 0._wp   ;   triadj (:,:,jpk,:,:) = 0._wp 
    500        
     503      !!gm _iso set to zero missing 
     504      triadi  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero 
     505      triadj  (:,:,1,:,:) = 0._wp   ;   triadj (:,:,jpk,:,:) = 0._wp 
     506 
    501507      !-------------------------------------! 
    502508      !  Triads just below the Mixed Layer  ! 
    503509      !-------------------------------------! 
    504510      ! 
    505       DO jl = 0, 1               ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 
    506          DO kp = 0, 1            ! with only the slope-max limit   and   MASKED  
     511      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 
     512         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED 
    507513            DO jj = 1, jpjm1 
    508514               DO ji = 1, fs_jpim1 
    509515                  ip = jl   ;   jp = jl 
    510516                  jk = MIN( nmln(ji+ip,jj) , mbkt(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth) 
     517                  ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    511518                  zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    512                      &      + ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk) 
     519                     &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk) 
    513520                  jk = MIN( nmln(ji,jj+jp) , mbkt(ji,jj+jp) ) + 1 
    514521                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    515                      &      + ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
     522                     &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
    516523                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    517524                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    … …  
    525532      !-------------------------------------! 
    526533      ! 
    527       DO kp = 0, 1                        ! k-index of triads 
     534      DO kp = 0, 1                            ! k-index of triads 
    528535         DO jl = 0, 1 
    529             ip = jl   ;   jp = jl         ! i- and j-indices of triads (i-k and j-k planes) 
     536            ip = jl   ;   jp = jl             ! i- and j-indices of triads (i-k and j-k planes) 
    530537            DO jk = 1, jpkm1 
     538               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 
     539               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0 
    531540               DO jj = 1, jpjm1 
    532                   DO ji = 1, fs_jpim1   ! vector opt. 
     541                  DO ji = 1, fs_jpim1         ! vector opt. 
    533542                     ! 
    534543                     ! Calculate slope relative to geopotentials used for GM skew fluxes 
    535                      ! For s-coordinate, subtract slope at t-points (equivalent to *adding* gradient of depth) 
     544                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    536545                     ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point 
    537546                     ! masked by umask taken at the level of dz(rho) 
    … …  
    541550                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked 
    542551                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp) 
    543                      zti_coord = ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
    544                      ztj_coord = ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj) 
    545                   ! unmasked 
    546                      zti_g_raw = zti_raw + zti_coord      ! ref to geopot surfaces 
    547                      ztj_g_raw = ztj_raw + ztj_coord 
     552 
     553                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
     554                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
     555                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked 
     556                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
     557                     ztj_g_raw = ztj_raw - ztj_coord 
    548558                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    549559                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    550560                     ! 
    551                      ! Below  ML use limited zti_g as is 
    552                      ! Inside ML replace by linearly reducing sx_mlb towards surface 
     561                     ! Below  ML use limited zti_g as is & mask 
     562                     ! Inside ML replace by linearly reducing sx_mlb towards surface & mask 
    553563                     ! 
    554564                     zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1 
    555565                     zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1 
    556566                     !                                                          !                   otherwise  zfact=0 
    557                      zti_g_lim =          zfacti   * zti_g_lim                       & 
     567                     zti_g_lim =          ( zfacti   * zti_g_lim                       & 
    558568                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   & 
    559                         &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) 
    560                      ztj_g_lim =          zfactj   * ztj_g_lim                       & 
     569                        &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 
     570                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       & 
    561571                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   & 
    562                         &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp)                   ! masked 
    563                      ! 
    564                      triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim * umask(ji,jj,jk+kp) 
    565                      triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim * vmask(ji,jj,jk+kp) 
     572                        &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 
     573                     ! 
     574                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim 
     575                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim 
    566576                     ! 
    567577                     ! Get coefficients of isoneutral diffusion tensor 
    … …  
    572582                     ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2 
    573583                     ! 
    574                      zti_lim  = zti_g_lim - zti_coord    ! remove the coordinate slope  ==> relative to coordinate surfaces 
    575                      ztj_lim  = ztj_g_lim - ztj_coord                                  
    576                      zti_lim2 = zti_lim * zti_lim * umask(ji,jj,jk+kp)      ! square of limited slopes            ! masked <<== 
    577                      ztj_lim2 = ztj_lim * ztj_lim * vmask(ji,jj,jk+kp) 
    578                      ! 
     584                     zti_lim  = ( zti_g_lim + zti_coord ) * umask(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces 
     585                     ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask(ji,jj,jk+kp) 
     586                     ! 
     587                     IF( ln_triad_iso ) THEN 
     588                        zti_raw = ( zti_lim*zti_lim ) / zti_raw 
     589                        ztj_raw = ( ztj_lim*ztj_lim ) / ztj_raw 
     590                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 
     591                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 
     592                        zti_lim =           zfacti   * zti_lim                       & 
     593                        &      + ( 1._wp - zfacti ) * zti_raw 
     594                        ztj_lim =           zfactj   * ztj_lim                       & 
     595                        &      + ( 1._wp - zfactj ) * ztj_raw 
     596                     ENDIF 
     597                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim 
     598                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim 
     599                    ! 
    579600                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   ) 
    580601                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   ) 
    … …  
    582603                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 
    583604                     ! 
    584                      triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim2 / zti_raw                                          ! masked 
    585                      triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim2 / ztj_raw 
    586                      ! 
    587 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
    588                      wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_lim2             ! masked 
    589                      wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_lim2 
     605                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
     606                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * ( zti_g_lim * zti_g_lim )      ! masked 
     607                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ( ztj_g_lim * ztj_g_lim ) 
    590608                  END DO 
    591609               END DO 
    … …  
    595613      ! 
    596614      wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero 
    597        
     615 
    598616      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    599617      ! 
    … …  
    609627      !!                  ***  ROUTINE ldf_slp_mxl  *** 
    610628      !! 
    611       !! ** Purpose :   Compute the slopes of iso-neutral surface just below  
     629      !! ** Purpose :   Compute the slopes of iso-neutral surface just below 
    612630      !!              the mixed layer. 
    613631      !! 
    … …  
    618636      !! 
    619637      !! ** Action  :   uslpml, wslpiml :  i- &  j-slopes of neutral surfaces 
    620       !!                vslpml, wslpjml    just below the mixed layer  
     638      !!                vslpml, wslpjml    just below the mixed layer 
    621639      !!                omlmask         :  mixed layer mask 
    622640      !!---------------------------------------------------------------------- 
    … …  
    626644      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point) 
    627645      !! 
    628       INTEGER  ::   ji , jj , jk         ! dummy loop indices 
    629       INTEGER  ::   iku, ikv, ik, ikm1   ! local integers 
     646      INTEGER  ::   ji , jj , jk                   ! dummy loop indices 
     647      INTEGER  ::   iku, ikv, ik, ikm1             ! local integers 
    630648      REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars 
    631649      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    … …  
    643661      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp 
    644662      ! 
    645       !                          !==   surface mixed layer mask   ! 
    646       DO jk = 1, jpk                      ! =1 inside the mixed layer, =0 otherwise 
     663      !                                            !==   surface mixed layer mask   ! 
     664      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    647665# if defined key_vectopt_loop 
    648666         DO jj = 1, 1 
    649             DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     667            DO ji = 1, jpij                        ! vector opt. (forced unrolling) 
    650668# else 
    651669         DO jj = 1, jpj 
    … …  
    678696         DO ji = 2, jpim1 
    679697# endif 
    680             !                    !==   Slope at u- & v-points just below the Mixed Layer   ==! 
     698            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==! 
    681699            ! 
    682             !                          !- vertical density gradient for u- and v-slopes (from dzr at T-point) 
     700            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point) 
    683701            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1) 
    684             ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !  
     702            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   ! 
    685703            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) ) 
    686704            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) ) 
    687             !                          !- horizontal density gradient at u- & v-points 
     705            !                        !- horizontal density gradient at u- & v-points 
    688706            zau = p_gru(ji,jj,iku) / e1u(ji,jj) 
    689707            zav = p_grv(ji,jj,ikv) / e2v(ji,jj) 
    690             !                          !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    691             !                                kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     708            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
     709            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    692710            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  ) 
    693711            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  ) 
    694             !                          !- Slope at u- & v-points (uslpml, vslpml) 
     712            !                        !- Slope at u- & v-points (uslpml, vslpml) 
    695713            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) 
    696714            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ikv) 
    697715            ! 
    698             !                    !==   i- & j-slopes at w-points just below the Mixed Layer   ==! 
     716            !                        !==   i- & j-slopes at w-points just below the Mixed Layer   ==! 
    699717            ! 
    700718            ik   = MIN( nmln(ji,jj) + 1, jpk ) 
    701719            ikm1 = MAX( 1, ik-1 ) 
    702             !                          !- vertical density gradient for w-slope (from N^2) 
     720            !                        !- vertical density gradient for w-slope (from N^2) 
    703721            zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. ) 
    704             !                          !- horizontal density i- & j-gradient at w-points 
     722            !                        !- horizontal density i- & j-gradient at w-points 
    705723            zci = MAX(   umask(ji-1,jj,ik  ) + umask(ji,jj,ik  )           & 
    706                &       + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps  ) * e1t(ji,jj)  
     724               &       + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps  ) * e1t(ji,jj) 
    707725            zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           & 
    708726               &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj) 
    … …  
    711729            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           & 
    712730               &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask(ji,jj,ik) 
    713             !                          !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    714             !                             kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     731            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
     732            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    715733            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zai )  ) 
    716734            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  ) 
    717             !                          !- i- & j-slope at w-points (wslpiml, wslpjml) 
     735            !                        !- i- & j-slope at w-points (wslpiml, wslpjml) 
    718736            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 
    719737            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik) 
    720738         END DO 
    721739      END DO 
    722 !!gm this lbc_lnk should be useless.... 
     740      !!gm this lbc_lnk should be useless.... 
    723741      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change) 
    724742      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions 
    … …  
    733751      !! ** Purpose :   Initialization for the isopycnal slopes computation 
    734752      !! 
    735       !! ** Method  :   read the nammbf namelist and check the parameter  
    736       !!              values called by tra_dmp at the first timestep (nit000) 
     753      !! ** Method  :   read the nammbf namelist and check the parameter 
     754      !!      values called by tra_dmp at the first timestep (nit000) 
    737755      !!---------------------------------------------------------------------- 
    738756      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    739757      INTEGER ::   ierr         ! local integer 
    740758      !!---------------------------------------------------------------------- 
    741        
    742       IF(lwp) THEN     
     759 
     760      IF(lwp) THEN 
    743761         WRITE(numout,*) 
    744762         WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing' 
    745763         WRITE(numout,*) '~~~~~~~~~~~~' 
    746764      ENDIF 
    747        
     765 
    748766      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes 
    749767         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    … …  
    754772         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 
    755773         ! 
    756          IF( ( ln_traldf_hor .OR. ln_dynldf_hor ) .AND. ln_sco )   & 
    757             CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator in s-coordinate not supported' ) 
    758          ! 
    759774      ELSE                             ! Madec operator : slopes at u-, v-, and w-points 
    760775         ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                & 
    … …  
    769784         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
    770785 
    771 !!gm I no longer understand this..... 
     786         !!gm I no longer understand this..... 
    772787         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 
    773788            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
    … …  
    802817   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag 
    803818CONTAINS 
    804    SUBROUTINE ldf_slp( kt, prd, pn2 )        ! Dummy routine 
    805       INTEGER, INTENT(in) :: kt  
     819   SUBROUTINE ldf_slp( kt, prd, pn2 )   ! Dummy routine 
     820      INTEGER, INTENT(in) :: kt 
    806821      REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2 
    807822      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 
    … …  
    811826      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt 
    812827   END SUBROUTINE ldf_slp_grif 
    813    SUBROUTINE ldf_slp_init       ! Dummy routine 
     828   SUBROUTINE ldf_slp_init              ! Dummy routine 
    814829   END SUBROUTINE ldf_slp_init 
    815830#endif 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r2715 r3116  
    6767         &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   & 
    6868         &                 ln_traldf_grif , ln_traldf_gdia,                   & 
     69         &                 ln_triad_iso   , ln_botmix_grif,                   & 
    6970         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       & 
    7071         &                 rn_slpmax 
    … …  
    9495         WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax 
    9596         WRITE(numout,*) '   + griffies operator internal controls not set via the namelist (experimental): ' 
    96          WRITE(numout,*) '      calculate triads twice        l_triad_iso     = ', l_triad_iso 
    97          WRITE(numout,*) '      no Shapiro filter             l_no_smooth     = ', l_no_smooth 
     97         WRITE(numout,*) '      calculate triads twice        ln_triad_iso    = ', ln_triad_iso 
     98         WRITE(numout,*) '      GM -->lat mixing on bottom    ln_botmix_grif  = ', ln_botmix_grif 
    9899         WRITE(numout,*) 
    99100      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r2977 r3116  
    3232 
    3333   REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names 
    34    LOGICAL , PUBLIC ::   l_triad_iso     = .FALSE.   !: calculate triads twice 
    35    LOGICAL , PUBLIC ::   l_no_smooth     = .FALSE.   !: no Shapiro smoothing 
     34   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.   !: calculate triads twice 
     35   LOGICAL , PUBLIC ::   ln_botmix_grif  = .FALSE.   !: mixing on bottom 
     36   LOGICAL , PUBLIC ::   l_grad_zps      = .FALSE.   !: special treatment for Horz Tgradients w partial steps  
    3637 
    3738   REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r2977 r3116  
    12371237         WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 
    12381238      END SUBROUTINE obc_dta 
     1239      !!----------------------------------------------------------------------------- 
     1240      !!   Default option 
     1241      !!----------------------------------------------------------------------------- 
     1242      SUBROUTINE obc_dta_bt ( kt, kbt )     ! Empty routine 
     1243         INTEGER,INTENT(in) :: kt 
     1244         INTEGER, INTENT( in ) ::   kbt     ! barotropic ocean time-step index 
     1245         WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 
     1246         WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 
     1247      END SUBROUTINE obc_dta_bt 
    12391248#endif 
    12401249   !!============================================================================== 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r2715 r3116  
    1313   !!   " "  !  06-01  (W. Park) modification of physical part 
    1414   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange 
     15   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields 
    1516   !!---------------------------------------------------------------------- 
    1617#if defined key_oasis3 
    … …  
    5253   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
    5354    
    54    TYPE, PUBLIC ::   FLD_CPL            !: Type for coupling field information 
    55       LOGICAL            ::   laction   ! To be coupled or not 
    56       CHARACTER(len = 8) ::   clname    ! Name of the coupling field    
    57       CHARACTER(len = 1) ::   clgrid    ! Grid type   
    58       REAL(wp)           ::   nsgn      ! Control of the sign change 
    59       INTEGER            ::   nid       ! Id of the field 
     55   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
     56      LOGICAL               ::   laction   ! To be coupled or not 
     57      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field    
     58      CHARACTER(len = 1)    ::   clgrid    ! Grid type   
     59      REAL(wp)              ::   nsgn      ! Control of the sign change 
     60      INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories) 
     61      INTEGER               ::   nct       ! Number of categories in field 
    6062   END TYPE FLD_CPL 
    6163 
    … …  
    118120      INTEGER :: paral(5)       ! OASIS3 box partition 
    119121      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
    120       INTEGER :: ji             ! local loop indicees 
     122      INTEGER :: ji,jc          ! local loop indicees 
     123      CHARACTER(LEN=8) :: zclname 
    121124      !!-------------------------------------------------------------------- 
    122125 
    … …  
    164167      DO ji = 1, ksnd 
    165168         IF ( ssnd(ji)%laction ) THEN  
    166             CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  & 
    167                &                      PRISM_Out   , ishape   , PRISM_REAL, nerror) 
    168             IF ( nerror /= PRISM_Ok ) THEN 
    169                WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) 
    170                CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    171             ENDIF 
     169            DO jc = 1, ssnd(ji)%nct 
     170               IF ( ssnd(ji)%nct .gt. 1 ) THEN 
     171                  WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 
     172               ELSE 
     173                  zclname=ssnd(ji)%clname 
     174               ENDIF 
     175               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 
     176               CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
     177                    PRISM_Out, ishape, PRISM_REAL, nerror) 
     178               IF ( nerror /= PRISM_Ok ) THEN 
     179                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
     180                  CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
     181               ENDIF 
     182            END DO 
    172183         ENDIF 
    173184      END DO 
    … …  
    177188      DO ji = 1, krcv 
    178189         IF ( srcv(ji)%laction ) THEN  
    179             CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   & 
    180                &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    181             IF ( nerror /= PRISM_Ok ) THEN 
    182                WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) 
    183                CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    184             ENDIF 
     190            DO jc = 1, srcv(ji)%nct 
     191               IF ( srcv(ji)%nct .gt. 1 ) THEN 
     192                  WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 
     193               ELSE 
     194                  zclname=srcv(ji)%clname 
     195               ENDIF 
     196               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
     197               CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
     198                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
     199               IF ( nerror /= PRISM_Ok ) THEN 
     200                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
     201                  CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
     202               ENDIF 
     203            END DO 
    185204         ENDIF 
    186205      END DO 
    … …  
    203222      !!      like sst or ice cover to the coupler or remote application. 
    204223      !!---------------------------------------------------------------------- 
    205       INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array 
    206       INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    207       INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    208       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pdata 
     224      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array 
     225      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
     226      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
     227      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata 
     228      !! 
     229      INTEGER                                   ::   jc        ! local loop index 
    209230      !!-------------------------------------------------------------------- 
    210231      ! 
    211232      ! snd data to OASIS3 
    212233      ! 
    213       CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 
    214        
    215       IF ( ln_ctl ) THEN         
    216          IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
    217             & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
    218             WRITE(numout,*) '****************' 
    219             WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
    220             WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 
    221             WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
    222             WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
    223             WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata) 
    224             WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata) 
    225             WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    226             WRITE(numout,*) '****************' 
     234      DO jc = 1, ssnd(kid)%nct 
     235 
     236         CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     237          
     238         IF ( ln_ctl ) THEN         
     239            IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
     240                 & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
     241               WRITE(numout,*) '****************' 
     242               WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
     243               WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 
     244               WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
     245               WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
     246               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     247               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     248               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     249               WRITE(numout,*) '****************' 
     250            ENDIF 
    227251         ENDIF 
    228       ENDIF 
     252 
     253      ENDDO 
    229254      ! 
    230255    END SUBROUTINE cpl_prism_snd 
    … …  
    238263      !!      like stresses and fluxes from the coupler or remote application. 
    239264      !!---------------------------------------------------------------------- 
    240       INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array 
    241       INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    242       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
    243       INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    244       !! 
    245       LOGICAL ::   llaction 
     265      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array 
     266      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
     267      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
     268      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
     269      !! 
     270      INTEGER                                   ::   jc        ! local loop index 
     271      LOGICAL                                   ::   llaction 
    246272      !!-------------------------------------------------------------------- 
    247273      ! 
    248274      ! receive local data from OASIS3 on every process 
    249275      ! 
    250       CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )          
    251  
    252       llaction = .false. 
    253       IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    254           kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    255  
    256       IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 
    257  
    258       IF ( llaction ) THEN 
    259  
    260          kinfo = OASIS_Rcv 
    261          pdata(nldi:nlei, nldj:nlej) = exfld(:,:) 
    262           
    263          !--- Fill the overlap areas and extra hallows (mpp) 
    264          !--- check periodicity conditions (all cases) 
    265          CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )    
    266           
    267          IF ( ln_ctl ) THEN         
    268             WRITE(numout,*) '****************' 
    269             WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    270             WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid 
    271             WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    272             WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
    273             WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata) 
    274             WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata) 
    275             WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    276             WRITE(numout,*) '****************' 
     276      DO jc = 1, srcv(kid)%nct 
     277 
     278         CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )          
     279          
     280         llaction = .false. 
     281         IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
     282              kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
     283          
     284         IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 
     285          
     286         IF ( llaction ) THEN 
     287             
     288            kinfo = OASIS_Rcv 
     289            pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
     290             
     291            !--- Fill the overlap areas and extra hallows (mpp) 
     292            !--- check periodicity conditions (all cases) 
     293            CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     294             
     295            IF ( ln_ctl ) THEN         
     296               WRITE(numout,*) '****************' 
     297               WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
     298               WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc) 
     299               WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
     300               WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
     301               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     302               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     303               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     304               WRITE(numout,*) '****************' 
     305            ENDIF 
     306             
     307         ELSE 
     308            kinfo = OASIS_idle      
    277309         ENDIF 
    278        
    279       ELSE 
    280          kinfo = OASIS_idle      
    281       ENDIF 
     310          
     311      ENDDO 
    282312      ! 
    283313   END SUBROUTINE cpl_prism_rcv 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r2777 r3116  
    2424   IMPLICIT NONE 
    2525   PRIVATE    
     26  
     27   PUBLIC   fld_map    ! routine called by tides_init 
    2628 
    2729   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
    … …  
    5658      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated 
    5759   END TYPE FLD 
     60 
     61   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays 
     62      INTEGER, POINTER   ::  ptr(:) 
     63   END TYPE MAP_POINTER 
    5864 
    5965!$AGRIF_DO_NOT_TREAT 
    … …  
    98104CONTAINS 
    99105 
    100    SUBROUTINE fld_read( kt, kn_fsbc, sd ) 
     106   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 
    101107      !!--------------------------------------------------------------------- 
    102108      !!                    ***  ROUTINE fld_read  *** 
    … …  
    113119      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)  
    114120      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
     121      TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping index 
     122      INTEGER  , INTENT(in   ), OPTIONAL     ::   jit       ! subcycle timestep for timesplitting option 
     123      INTEGER  , INTENT(in   ), OPTIONAL     ::   time_offset ! provide fields at time other than "now" 
     124                                                              ! time_offset = -1 => fields at "before" time level 
     125                                                              ! time_offset = +1 => fields at "after" time levels 
     126                                                              ! etc. 
    115127      !! 
    116128      INTEGER  ::   imf        ! size of the structure sd 
    … …  
    119131      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend 
    120132      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
     133      INTEGER  ::   time_add   ! local time_offset variable 
    121134      LOGICAL  ::   llnxtyr    ! open next year  file? 
    122135      LOGICAL  ::   llnxtmth   ! open next month file? 
    123136      LOGICAL  ::   llstop     ! stop is the file does not exist 
     137      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields 
    124138      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    125139      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    126140      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    127141      !!--------------------------------------------------------------------- 
     142      ll_firstcall = .false. 
     143      IF( PRESENT(jit) ) THEN 
     144         IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 
     145      ELSE 
     146         IF(kt == nit000) ll_firstcall = .true. 
     147      ENDIF 
     148 
     149      time_add = 0 
     150      IF( PRESENT(time_offset) ) THEN 
     151         time_add = time_offset 
     152      ENDIF 
     153          
    128154      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    129       isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! middle of sbc time step 
     155      IF( present(jit) ) THEN  
     156         ! ignore kn_fsbc in this case 
     157         isecsbc = nsec_year + nsec1jan000 + (jit+time_add)*rdt/REAL(nn_baro,wp)  
     158      ELSE 
     159         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + time_add * rdttra(1)  ! middle of sbc time step 
     160      ENDIF 
    130161      imf = SIZE( sd ) 
    131162      ! 
    132       IF( kt == nit000 ) THEN                      ! initialization 
    133          DO jf = 1, imf  
    134             CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
    135          END DO 
     163      IF( ll_firstcall ) THEN                      ! initialization 
     164         IF( PRESENT(map) ) THEN 
     165            DO jf = 1, imf  
     166               CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr )  ! read each before field (put them in after as they will be swapped) 
     167            END DO 
     168         ELSE 
     169            DO jf = 1, imf  
     170               CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
     171            END DO 
     172         ENDIF 
    136173         IF( lwp ) CALL wgt_print()                ! control print 
    137174         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
    … …  
    143180         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    144181             
    145             IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data? 
     182            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data? 
    146183 
    147184               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations 
    … …  
    151188               ENDIF 
    152189 
    153                CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations 
     190               IF( PRESENT(jit) ) THEN 
     191                  CALL fld_rec( kn_fsbc, sd(jf), jit=jit )              ! update record informations 
     192               ELSE 
     193                  CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations 
     194               ENDIF 
    154195 
    155196               ! do we have to change the year/month/week/day of the forcing field??  
    … …  
    212253 
    213254               ! read after data 
    214                CALL fld_get( sd(jf) ) 
     255               IF( PRESENT(map) ) THEN 
     256                  CALL fld_get( sd(jf), map(jf)%ptr ) 
     257               ELSE 
     258                  CALL fld_get( sd(jf) ) 
     259               ENDIF 
    215260 
    216261            ENDIF 
    … …  
    225270                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    226271                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 
    227                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   & 
     272                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    228273                     & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
     274                  WRITE(numout, *) 'time_add is : ',time_add 
    229275               ENDIF 
    230276               ! temporal interpolation weights 
    … …  
    253299 
    254300 
    255    SUBROUTINE fld_init( kn_fsbc, sdjf ) 
     301   SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 
    256302      !!--------------------------------------------------------------------- 
    257303      !!                    ***  ROUTINE fld_init  *** 
    … …  
    262308      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)  
    263309      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables 
     310      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
    264311      !! 
    265312      LOGICAL :: llprevyr              ! are we reading previous year  file? 
    … …  
    364411 
    365412         ! read before data  
    366          CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     413         IF( PRESENT(map) ) THEN 
     414            CALL fld_get( sdjf, map )  ! read before values in after arrays(as we will swap it later) 
     415         ELSE 
     416            CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     417         ENDIF 
    367418 
    368419         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
    … …  
    396447 
    397448 
    398    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore ) 
     449   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 
    399450      !!--------------------------------------------------------------------- 
    400451      !!                    ***  ROUTINE fld_rec  *** 
    … …  
    410461      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
    411462      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
     463      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle 
    412464                                                        ! used only if sdjf%ln_tint = .TRUE. 
    413465      !! 
    … …  
    443495            !                             
    444496            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 
     497            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    445498            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    446499            ! swap at the middle of the year 
    … …  
    471524            !                             
    472525            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     526            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    473527            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    474528            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    … …  
    498552         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step 
    499553         ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error  
     554         IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    500555         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    501556            ! 
    … …  
    546601 
    547602 
    548    SUBROUTINE fld_get( sdjf ) 
    549       !!--------------------------------------------------------------------- 
    550       !!                    ***  ROUTINE fld_clopn  *** 
     603   SUBROUTINE fld_get( sdjf, map ) 
     604      !!--------------------------------------------------------------------- 
     605      !!                    ***  ROUTINE fld_get  *** 
    551606      !! 
    552607      !! ** Purpose :   read the data 
    553608      !!---------------------------------------------------------------------- 
    554609      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables 
     610      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
    555611      !! 
    556612      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    … …  
    559615             
    560616      ipk = SIZE( sdjf%fnow, 3 ) 
    561       IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
     617 
     618      IF( PRESENT(map) ) THEN 
     619         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 
     620         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map ) 
     621         ENDIF 
     622      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    562623         CALL wgt_list( sdjf, iw ) 
    563624         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    … …  
    581642   END SUBROUTINE fld_get 
    582643 
     644   SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 
     645      !!--------------------------------------------------------------------- 
     646      !!                    ***  ROUTINE fld_get  *** 
     647      !! 
     648      !! ** Purpose :   read global data from file and map onto local data 
     649      !!                using a general mapping (for open boundaries) 
     650      !!---------------------------------------------------------------------- 
     651#if defined key_bdy 
     652      USE bdy_oce, ONLY:  dta_global         ! workspace to read in global data arrays 
     653#endif  
     654 
     655      INTEGER                   , INTENT(in ) ::   num     ! stream number 
     656      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name 
     657      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional) 
     658      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice) 
     659      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices 
     660      !! 
     661      INTEGER                                 ::   ipi      ! length of boundary data on local process 
     662      INTEGER                                 ::   ipj      ! length of dummy dimension ( = 1 ) 
     663      INTEGER                                 ::   ipk      ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     664      INTEGER                                 ::   ilendta  ! length of data in file 
     665      INTEGER                                 ::   idvar    ! variable ID 
     666      INTEGER                                 ::   ib, ik   ! loop counters 
     667      INTEGER                                 ::   ierr 
     668      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read ! work space for global data 
     669      !!--------------------------------------------------------------------- 
     670             
     671#if defined key_bdy 
     672      dta_read => dta_global 
     673#endif 
     674 
     675      ipi = SIZE( dta, 1 ) 
     676      ipj = 1 
     677      ipk = SIZE( dta, 3 ) 
     678 
     679      idvar   = iom_varid( num, clvar ) 
     680      ilendta = iom_file(num)%dimsz(1,idvar) 
     681      IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 
     682      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 
     683 
     684      SELECT CASE( ipk ) 
     685      CASE(1)    
     686         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec ) 
     687      CASE DEFAULT 
     688         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 
     689      END SELECT 
     690      ! 
     691      DO ib = 1, ipi 
     692         DO ik = 1, ipk 
     693            dta(ib,1,ik) =  dta_read(map(ib),1,ik) 
     694         END DO 
     695      END DO 
     696 
     697   END SUBROUTINE fld_map 
     698 
    583699 
    584700   SUBROUTINE fld_rot( kt, sd ) 
    585701      !!--------------------------------------------------------------------- 
    586       !!                    ***  ROUTINE fld_clopn  *** 
     702      !!                    ***  ROUTINE fld_rot  *** 
    587703      !! 
    588704      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction 
    589705      !!---------------------------------------------------------------------- 
    590706      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    591       USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5      ! 2D workspace 
     707      USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25      ! 2D workspace 
    592708      !! 
    593709      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    … …  
    601717      !!--------------------------------------------------------------------- 
    602718 
    603       IF(wrk_in_use(2, 4,5) ) THEN 
     719      IF(wrk_in_use(2, 24,25) ) THEN 
    604720         CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    605721      END IF 
    … …  
    638754       END DO 
    639755      ! 
    640       IF(wrk_not_released(2, 4,5) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
     756      IF(wrk_not_released(2, 24,25) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
    641757      ! 
    642758   END SUBROUTINE fld_rot 
    … …  
    672788      ! 
    673789      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    674       ! 
     790     ! 
    675791   END SUBROUTINE fld_clopn 
    676792 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r2777 r3116  
    66   !! History :  3.0  ! 2006-08  (G. Madec)  Surface module 
    77   !!            3.2  ! 2009-06  (S. Masson) merge with ice_oce 
    8    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     8   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     9   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    910   !!---------------------------------------------------------------------- 
    10 #if defined key_lim3 || defined key_lim2 
     11#if defined key_lim3 || defined key_lim2 || defined key_cice 
    1112   !!---------------------------------------------------------------------- 
    1213   !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model 
    … …  
    1920   USE par_ice_2        ! LIM-2 parameters 
    2021# endif 
     22# if defined key_cice  
     23   USE ice_domain_size, only: ncat  
     24#endif 
    2125   USE lib_mpp          ! MPP library 
    2226   USE in_out_manager   ! I/O manager 
    … …  
    3034   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    3135   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
     36   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    3237#  if defined key_lim2_vp 
    3338   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner) 
    … …  
    3944   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    4045   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model 
     46   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    4147   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: 'C'-grid ice-velocity 
    4248# endif 
     49# if defined  key_cice 
     50   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
     51   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
     52   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model 
     53   CHARACTER(len=1), PUBLIC            ::   cp_ice_msh = 'F'      !: 'F'-grid ice-velocity 
     54# endif 
    4355 
     56#if defined key_lim3 || defined key_lim2  
    4457   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice   !: non solar heat flux over ice                  [W/m2] 
    4558   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice   !: solar heat flux over ice                      [W/m2] 
    … …  
    6073# endif 
    6174 
     75#elif defined key_cice 
     76   ! 
     77   ! for consistency with LIM, these are declared with three dimensions 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qlw_ice            !: incoming long-wave 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice            !: latent flux over ice           [W/m2] 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice            !: solar heat flux over ice       [W/m2] 
     81   ! 
     82   ! other forcing arrays are two dimensional 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iou             !: x ice-ocean surface stress at NEMO U point 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iov             !: y ice-ocean surface stress at NEMO V point 
     85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice            !: sublimation-snow budget over ice    [kg/m2] 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice           !: air temperature 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qatm_ice           !: specific humidity 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndi_ice           !: i wind at T point 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndj_ice           !: j wind at T point 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfrzmlt            !: NEMO frzmlt 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point 
     93   ! 
     94   ! finally, arrays corresponding to different ice categories 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt           !: category topmelt 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt           !: category botmelt 
     98#endif 
     99 
    62100   !!---------------------------------------------------------------------- 
    63101   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    … …  
    71109      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    72110      !!---------------------------------------------------------------------- 
     111#if defined key_lim3 || defined key_lim2 
    73112      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    74113         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    … …  
    77116         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
    78117         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    79 # if defined key_lim3 
     118#if defined key_lim3 
    80119         &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= sbc_ice_alloc ) 
    81 # else 
     120#else 
    82121         &      emp_ice(jpi,jpj)                              , STAT= sbc_ice_alloc ) 
    83 # endif 
     122#endif 
     123#elif defined key_cice 
     124      ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
     125                wndi_ice(jpi,jpj)     , tatm_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , & 
     126                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
     127                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
     128                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= sbc_ice_alloc ) 
     129#endif 
    84130         ! 
    85131      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
    … …  
    89135#else 
    90136   !!---------------------------------------------------------------------- 
    91    !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model 
     137   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    92138   !!---------------------------------------------------------------------- 
    93139   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    94140   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
     141   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    95142   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
    96143#endif 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r2715 r3116  
    1010   !!   sbc_apr        : read atmospheric pressure in netcdf files  
    1111   !!---------------------------------------------------------------------- 
    12    USE bdy_par         ! Unstructured boundary parameters 
    1312   USE obc_par         ! open boundary condition parameters 
    1413   USE dom_oce         ! ocean space and time domain 
    … …  
    3029   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) * 
    3130   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data  
    32    LOGICAL, PUBLIC ::   ln_apr_bdy = .FALSE.  !: inverse barometer added to BDY ssh data 
    3331   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F) 
    3432 
    … …  
    115113         ! 
    116114         !                                            !* control check 
    117          IF( ln_apr_obc .OR. ln_apr_bdy  )   & 
    118             CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDY ssh data not yet implemented ' ) 
     115         IF( ln_apr_obc )   & 
     116            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' ) 
    119117         IF( ln_apr_obc .AND. .NOT. lk_obc )   & 
    120118            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' ) 
    121          IF( ln_apr_bdy .AND. .NOT. lk_bdy )   & 
    122             CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' ) 
    123          IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts )   & 
     119         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   & 
    124120            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 
    125          IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. ln_apr_dyn   )   & 
     121         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   & 
    126122            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
    127123      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3105 r3116  
    1414   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put 
    1515   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
     16   !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE 
    1617   !!---------------------------------------------------------------------- 
    1718 
    … …  
    3536   USE prtctl          ! Print control 
    3637   USE sbcwave,ONLY :  cdn_wave !wave module  
    37 #if defined key_lim3 
     38#if defined key_lim3 || defined key_cice 
    3839   USE sbc_ice         ! Surface boundary condition: ice fields 
    3940#endif 
    … …  
    184185      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
    185186      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 
     187 
     188#if defined key_cice 
     189      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
     190         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1)  
     191         qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1) 
     192         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)          
     193         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
     194         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
     195         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
     196         wndi_ice(:,:)    = sf(jp_wndi)%fnow(:,:,1) 
     197         wndj_ice(:,:)    = sf(jp_wndj)%fnow(:,:,1) 
     198      ENDIF 
     199#endif 
    186200      ! 
    187201   END SUBROUTINE sbc_blk_core 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r2977 r3116  
    77   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module 
    88   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 
     9   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_oasis3 || defined key_oasis4 
    … …  
    5152#endif 
    5253   USE diaar5, ONLY :   lk_diaar5 
     54#if defined key_cice 
     55   USE ice_domain_size, only: ncat 
     56#endif 
    5357   IMPLICIT NONE 
    5458   PRIVATE 
    … …  
    8993   INTEGER, PARAMETER ::   jpr_cal    = 29            ! calving 
    9094   INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module 
    91 #if ! defined key_cpl_carbon_cycle 
    92    INTEGER, PARAMETER ::   jprcv      = 30            ! total number of fields received 
    93 #else 
    9495   INTEGER, PARAMETER ::   jpr_co2    = 31 
    95    INTEGER, PARAMETER ::   jprcv      = 31            ! total number of fields received 
    96 #endif    
     96   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
     97   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
     98   INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
     99 
    97100   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
    98101   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    … …  
    109112   INTEGER, PARAMETER ::   jps_ivy1   = 13            ! 
    110113   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    111 #if ! defined key_cpl_carbon_cycle 
    112    INTEGER, PARAMETER ::   jpsnd      = 14            ! total number of fields sended 
    113 #else 
    114114   INTEGER, PARAMETER ::   jps_co2    = 15 
    115115   INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended 
    116 #endif    
     116 
    117117   !                                                         !!** namelist namsbc_cpl ** 
    118    ! Send to the atmosphere                                   ! 
    119    CHARACTER(len=100) ::   cn_snd_temperature = 'oce only'    ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 
    120    CHARACTER(len=100) ::   cn_snd_albedo      = 'none'        ! 'none' 'weighted ice' or 'mixed oce-ice' 
    121    CHARACTER(len=100) ::   cn_snd_thickness   = 'none'        ! 'none' or 'weighted ice and snow' 
    122    CHARACTER(len=100) ::   cn_snd_crt_nature  = 'none'        ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice'    
    123    CHARACTER(len=100) ::   cn_snd_crt_refere  = 'spherical'   ! 'spherical' or 'cartesian' 
    124    CHARACTER(len=100) ::   cn_snd_crt_orient  = 'local grid'  ! 'eastward-northward' or 'local grid' 
    125    CHARACTER(len=100) ::   cn_snd_crt_grid    = 'T'           ! always at 'T' point 
    126 #if defined key_cpl_carbon_cycle  
    127    CHARACTER(len=100) ::   cn_snd_co2         = 'none'        ! 'none' or 'coupled' 
     118   TYPE ::   FLD_C 
     119      CHARACTER(len = 32) ::   cldes                  ! desciption of the coupling strategy 
     120      CHARACTER(len = 32) ::   clcat                  ! multiple ice categories strategy 
     121      CHARACTER(len = 32) ::   clvref                 ! reference of vector ('spherical' or 'cartesian') 
     122      CHARACTER(len = 32) ::   clvor                  ! orientation of vector fields ('eastward-northward' or 'local grid') 
     123      CHARACTER(len = 32) ::   clvgrd                 ! grids on which is located the vector fields 
     124   END TYPE FLD_C 
     125   ! Send to the atmosphere                           ! 
     126   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
     127   ! Received from the atmosphere                     ! 
     128   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
     129   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     130 
     131   TYPE ::   DYNARR      
     132      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     133   END TYPE DYNARR 
     134 
     135   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                      ! all fields recieved from the atmosphere 
     136 
     137   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     138 
     139   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
     140 
     141#if ! defined key_lim2   &&   ! defined key_lim3 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    128144#endif 
    129    ! Received from the atmosphere                             ! 
    130    CHARACTER(len=100) ::   cn_rcv_tau_nature  = 'oce only'    ! 'oce only' 'oce and ice' or 'mixed oce-ice' 
    131    CHARACTER(len=100) ::   cn_rcv_tau_refere  = 'spherical'   ! 'spherical' or 'cartesian' 
    132    CHARACTER(len=100) ::   cn_rcv_tau_orient  = 'local grid'  ! 'eastward-northward' or 'local grid' 
    133    CHARACTER(len=100) ::   cn_rcv_tau_grid    = 'T'           ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V' 
    134    CHARACTER(len=100) ::   cn_rcv_w10m        = 'none'        ! 'none' or 'coupled' 
    135    CHARACTER(len=100) ::   cn_rcv_dqnsdt      = 'none'        ! 'none' or 'coupled' 
    136    CHARACTER(len=100) ::   cn_rcv_qsr         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 
    137    CHARACTER(len=100) ::   cn_rcv_qns         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 
    138    CHARACTER(len=100) ::   cn_rcv_emp         = 'oce only'    ! 'oce only' 'conservative' or 'oce and ice' 
    139    CHARACTER(len=100) ::   cn_rcv_rnf         = 'coupled'     ! 'coupled' 'climato' or 'mixed' 
    140    CHARACTER(len=100) ::   cn_rcv_cal         = 'none'        ! 'none' or 'coupled' 
    141    CHARACTER(len=100) ::   cn_rcv_taumod      = 'none'        ! 'none' or 'coupled' 
    142 #if defined key_cpl_carbon_cycle  
    143    CHARACTER(len=100) ::   cn_rcv_co2         = 'none'        ! 'none' or 'coupled' 
     145 
     146#if defined key_cice 
     147   INTEGER, PARAMETER ::   jpl = ncat 
     148#elif ! defined key_lim2   &&   ! defined key_lim3 
     149   INTEGER, PARAMETER ::   jpl = 1  
     150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    144152#endif 
    145153 
    146 !!   CHARACTER(len=100), PUBLIC ::   cn_rcv_rnf   !: ???             ==>>  !!gm   treat this case in a different maner 
    147     
    148    CHARACTER(len=100), DIMENSION(4) ::   cn_snd_crt           ! array combining cn_snd_crt_* 
    149    CHARACTER(len=100), DIMENSION(4) ::   cn_rcv_tau           ! array combining cn_rcv_tau_* 
    150  
    151    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
    152  
    153    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   frcv               ! all fields recieved from the atmosphere 
    154    INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    155  
    156 #if ! defined key_lim2   &&   ! defined key_lim3 
    157    ! quick patch to be able to run the coupled model without sea-ice... 
    158    INTEGER, PARAMETER ::   jpl = 1  
    159    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 
    160    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice ! (jpi,jpj,jpl) 
    161    REAL(wp) ::  lfus 
     154#if ! defined key_lim3   &&  ! defined key_cice 
     155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     156#endif 
     157 
     158#if ! defined key_lim3 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     160#endif 
     161 
     162#if ! defined key_cice 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    162164#endif 
    163165 
    … …  
    176178      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    177179      !!---------------------------------------------------------------------- 
    178       INTEGER :: ierr(2) 
     180      INTEGER :: ierr(4),jn 
    179181      !!---------------------------------------------------------------------- 
    180182      ierr(:) = 0 
    181183      ! 
    182       ALLOCATE( albedo_oce_mix(jpi,jpj), frcv(jpi,jpj,jprcv), nrcvinfo(jprcv),  STAT=ierr(1) ) 
     184      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    183185      ! 
    184186#if ! defined key_lim2 && ! defined key_lim3 
    185187      ! quick patch to be able to run the coupled model without sea-ice... 
    186       ALLOCATE( hicif(jpi,jpj) , u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) ,     & 
    187                 hsnif(jpi,jpj) , v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,jpl) , STAT=ierr(2) ) 
     188      ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
     189                v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
     190                emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     191#endif 
     192 
     193#if ! defined key_lim3 && ! defined key_cice 
     194      ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
     195#endif 
     196 
     197#if defined key_cice || defined key_lim2 
     198      ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    188199#endif 
    189200      sbc_cpl_alloc = MAXVAL( ierr ) 
    … …  
    213224      INTEGER ::   jn   ! dummy loop index 
    214225      !! 
    215       NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &           
    216          cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid ,                 & 
    217          cn_rcv_w10m      , cn_rcv_taumod     ,                                                      & 
    218          cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid ,                 & 
    219          cn_rcv_dqnsdt    , cn_rcv_qsr        , cn_rcv_qns       , cn_rcv_emp      , cn_rcv_rnf , cn_rcv_cal 
    220 #if defined key_cpl_carbon_cycle  
    221       NAMELIST/namsbc_cpl_co2/  cn_snd_co2, cn_rcv_co2 
    222 #endif 
     226      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
     227         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
     228         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
    223229      !!--------------------------------------------------------------------- 
    224230 
    … …  
    230236      !      Namelist informations       ! 
    231237      ! ================================ ! 
     238 
     239      ! default definitions 
     240      !                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     241      !                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     242      ! send 
     243      sn_snd_temp   = FLD_C( 'weighted oce and ice',    'no'    ,     ''      ,         ''           ,   ''   )  
     244      sn_snd_alb    = FLD_C( 'weighted ice'        ,    'no'    ,     ''      ,         ''           ,   ''   )  
     245      sn_snd_thick  = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''           ,   ''   )  
     246      sn_snd_crt    = FLD_C( 'none'                ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'   )      
     247      sn_snd_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''           ,   ''   )      
     248      ! receive 
     249      sn_rcv_w10m   = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     250      sn_rcv_taumod = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     251      sn_rcv_tau    = FLD_C( 'oce only'            ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'  )   
     252      sn_rcv_dqnsdt = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     253      sn_rcv_qsr    = FLD_C( 'oce and ice'         ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     254      sn_rcv_qns    = FLD_C( 'oce and ice'         ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     255      sn_rcv_emp    = FLD_C( 'conservative'        ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     256      sn_rcv_rnf    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     257      sn_rcv_cal    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     258      sn_rcv_iceflx = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     259      sn_rcv_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
    232260 
    233261      REWIND( numnam )                    ! ... read namlist namsbc_cpl 
    … …  
    238266         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    239267         WRITE(numout,*)'~~~~~~~~~~~~' 
    240          WRITE(numout,*)'   received fields' 
    241          WRITE(numout,*)'       10m wind module                    cn_rcv_w10m        = ', cn_rcv_w10m  
    242          WRITE(numout,*)'       surface stress - nature            cn_rcv_tau_nature  = ', cn_rcv_tau_nature 
    243          WRITE(numout,*)'                      - referential       cn_rcv_tau_refere  = ', cn_rcv_tau_refere 
    244          WRITE(numout,*)'                      - orientation       cn_rcv_tau_orient  = ', cn_rcv_tau_orient 
    245          WRITE(numout,*)'                      - mesh              cn_rcv_tau_grid    = ', cn_rcv_tau_grid 
    246          WRITE(numout,*)'       non-solar heat flux sensitivity    cn_rcv_dqnsdt      = ', cn_rcv_dqnsdt 
    247          WRITE(numout,*)'       solar heat flux                    cn_rcv_qsr         = ', cn_rcv_qsr   
    248          WRITE(numout,*)'       non-solar heat flux                cn_rcv_qns         = ', cn_rcv_qns 
    249          WRITE(numout,*)'       freshwater budget                  cn_rcv_emp         = ', cn_rcv_emp 
    250          WRITE(numout,*)'       runoffs                            cn_rcv_rnf         = ', cn_rcv_rnf 
    251          WRITE(numout,*)'       calving                            cn_rcv_cal         = ', cn_rcv_cal  
    252          WRITE(numout,*)'       stress module                      cn_rcv_taumod      = ', cn_rcv_taumod 
    253          WRITE(numout,*)'   sent fields' 
    254          WRITE(numout,*)'       surface temperature                cn_snd_temperature = ', cn_snd_temperature 
    255          WRITE(numout,*)'       albedo                             cn_snd_albedo      = ', cn_snd_albedo 
    256          WRITE(numout,*)'       ice/snow thickness                 cn_snd_thickness   = ', cn_snd_thickness   
    257          WRITE(numout,*)'       surface current - nature           cn_snd_crt_nature  = ', cn_snd_crt_nature  
    258          WRITE(numout,*)'                       - referential      cn_snd_crt_refere  = ', cn_snd_crt_refere  
    259          WRITE(numout,*)'                       - orientation      cn_snd_crt_orient  = ', cn_snd_crt_orient 
    260          WRITE(numout,*)'                       - mesh             cn_snd_crt_grid    = ', cn_snd_crt_grid  
    261       ENDIF 
    262  
    263 #if defined key_cpl_carbon_cycle  
    264       REWIND( numnam )                    ! read namlist namsbc_cpl_co2 
    265       READ  ( numnam, namsbc_cpl_co2 ) 
    266       IF(lwp) THEN                        ! control print 
    267          WRITE(numout,*) 
    268          WRITE(numout,*)'sbc_cpl_init : namsbc_cpl_co2 namelist ' 
    269          WRITE(numout,*)'~~~~~~~~~~~~' 
    270          WRITE(numout,*)'   received fields' 
    271          WRITE(numout,*)'       atm co2                            cn_rcv_co2         = ', cn_rcv_co2 
    272          WRITE(numout,*)'   sent fields' 
    273          WRITE(numout,*)'      oce co2 flux                        cn_snd_co2         = ', cn_snd_co2 
    274           WRITE(numout,*) 
    275       ENDIF 
    276 #endif 
    277       ! save current & stress in an array and suppress possible blank in the name 
    278       cn_snd_crt(1) = TRIM( cn_snd_crt_nature )   ;   cn_snd_crt(2) = TRIM( cn_snd_crt_refere ) 
    279       cn_snd_crt(3) = TRIM( cn_snd_crt_orient )   ;   cn_snd_crt(4) = TRIM( cn_snd_crt_grid   ) 
    280       cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature )   ;   cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere ) 
    281       cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient )   ;   cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid   ) 
    282  
    283       !                                   ! allocate zdfric arrays 
     268         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
     269         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     270         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 
     271         WRITE(numout,*)'      surface stress                  = ', TRIM(sn_rcv_tau%cldes   ), ' (', TRIM(sn_rcv_tau%clcat   ), ')' 
     272         WRITE(numout,*)'                     - referential    = ', sn_rcv_tau%clvref 
     273         WRITE(numout,*)'                     - orientation    = ', sn_rcv_tau%clvor 
     274         WRITE(numout,*)'                     - mesh           = ', sn_rcv_tau%clvgrd 
     275         WRITE(numout,*)'      non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' 
     276         WRITE(numout,*)'      solar heat flux                 = ', TRIM(sn_rcv_qsr%cldes   ), ' (', TRIM(sn_rcv_qsr%clcat   ), ')' 
     277         WRITE(numout,*)'      non-solar heat flux             = ', TRIM(sn_rcv_qns%cldes   ), ' (', TRIM(sn_rcv_qns%clcat   ), ')' 
     278         WRITE(numout,*)'      freshwater budget               = ', TRIM(sn_rcv_emp%cldes   ), ' (', TRIM(sn_rcv_emp%clcat   ), ')' 
     279         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
     280         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     281         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
     282         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     283         WRITE(numout,*)'  sent fields (multiple ice categories)' 
     284         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
     285         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')' 
     286         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 
     287         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')' 
     288         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref  
     289         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor 
     290         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
     291         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     292      ENDIF 
     293 
     294      !                                   ! allocate sbccpl arrays 
    284295      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    285296      
    … …  
    294305 
    295306      ! default definitions of srcv 
    296       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1. 
     307      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
    297308 
    298309      !                                                      ! ------------------------- ! 
    … …  
    315326      !  
    316327      ! Vectors: change of sign at north fold ONLY if on the local grid 
    317       IF( TRIM( cn_rcv_tau(3) ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
     328      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    318329       
    319330      !                                                           ! Set grid and action 
    320       SELECT CASE( TRIM( cn_rcv_tau(4) ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
     331      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
    321332      CASE( 'T' )  
    322333         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    … …  
    364375         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2 
    365376      CASE default    
    366          CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' ) 
     377         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 
    367378      END SELECT 
    368379      ! 
    369       IF( TRIM( cn_rcv_tau(2) ) == 'spherical' )   &           ! spherical: 3rd component not received 
     380      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received 
    370381         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.  
    371382      ! 
    372       IF( TRIM( cn_rcv_tau(1) ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used 
     383      IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used 
    373384         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received 
    374385         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation 
    … …  
    388399      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation 
    389400      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    390       SELECT CASE( TRIM( cn_rcv_emp ) ) 
     401      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    391402      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    392403      CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    393404      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
    394       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' ) 
     405      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
    395406      END SELECT 
    396407 
    … …  
    398409      !                                                      !     Runoffs & Calving     !    
    399410      !                                                      ! ------------------------- ! 
    400       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( cn_rcv_rnf ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    401                                                  IF( TRIM( cn_rcv_rnf ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    402                                                  ELSE                                           ;   ln_rnf = .FALSE. 
    403                                                  ENDIF 
    404       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( cn_rcv_cal ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     411      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
     412! This isn't right - really just want ln_rnf_emp changed 
     413!                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
     414!                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
     415!                                                 ENDIF 
     416      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    405417 
    406418      !                                                      ! ------------------------- ! 
    … …  
    410422      srcv(jpr_qnsice)%clname = 'O_QnsIce' 
    411423      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    412       SELECT CASE( TRIM( cn_rcv_qns ) ) 
     424      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
    413425      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    414426      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
    415427      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 
    416428      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE.  
    417       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' ) 
     429      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    418430      END SELECT 
    419  
     431      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     432         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    420433      !                                                      ! ------------------------- ! 
    421434      !                                                      !    solar radiation        !   Qsr 
    … …  
    424437      srcv(jpr_qsrice)%clname = 'O_QsrIce' 
    425438      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    426       SELECT CASE( TRIM( cn_rcv_qsr ) ) 
     439      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
    427440      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    428441      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
    429442      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 
    430443      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE.  
    431       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' ) 
     444      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    432445      END SELECT 
    433  
     446      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     447         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    434448      !                                                      ! ------------------------- ! 
    435449      !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
    436450      !                                                      ! ------------------------- ! 
    437451      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'    
    438       IF( TRIM( cn_rcv_dqnsdt ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
    439       ! 
    440       ! non solar sensitivity mandatory for ice model 
    441       IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. k_ice /= 0 ) & 
    442          CALL ctl_stop( 'sbc_cpl_init: cn_rcv_dqnsdt must be coupled in namsbc_cpl namelist' ) 
     452      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
     453      ! 
     454      ! non solar sensitivity mandatory for LIM ice model 
     455      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     456         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    443457      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
    444       IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. TRIM( cn_rcv_qns ) == 'mixed oce-ice' ) & 
    445          CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between cn_rcv_qns and cn_rcv_dqnsdt' ) 
     458      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 
     459         CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 
    446460      !                                                      ! ------------------------- ! 
    447461      !                                                      !    Ice Qsr penetration    !    
    … …  
    456470      !                                                      !      10m wind module      !    
    457471      !                                                      ! ------------------------- ! 
    458       srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(cn_rcv_w10m  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
     472      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
    459473      ! 
    460474      !                                                      ! ------------------------- ! 
    461475      !                                                      !   wind stress module      !    
    462476      !                                                      ! ------------------------- ! 
    463       srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(cn_rcv_taumod) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
     477      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    464478      lhftau = srcv(jpr_taum)%laction 
    465479 
    466 #if defined key_cpl_carbon_cycle 
    467480      !                                                      ! ------------------------- ! 
    468481      !                                                      !      Atmospheric CO2      ! 
    469482      !                                                      ! ------------------------- ! 
    470       srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(cn_rcv_co2   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
    471 #endif 
    472       
     483      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
     484      !                                                      ! ------------------------- ! 
     485      !                                                      !   topmelt and botmelt     !    
     486      !                                                      ! ------------------------- ! 
     487      srcv(jpr_topm )%clname = 'OTopMlt' 
     488      srcv(jpr_botm )%clname = 'OBotMlt' 
     489      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
     490         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
     491            srcv(jpr_topm:jpr_botm)%nct = jpl 
     492         ELSE 
     493            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 
     494         ENDIF 
     495         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
     496      ENDIF 
     497 
     498      ! Allocate all parts of frcv used for received fields 
     499      DO jn = 1, jprcv 
     500         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     501      END DO 
     502      ! Allocate taum part of frcv which is used even when not received as coupling field 
     503      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
     504 
    473505      ! ================================ ! 
    474506      !     Define the send interface    ! 
    475507      ! ================================ ! 
    476       ! for each field: define the OASIS name                           (srcv(:)%clname) 
    477       !                 define send or not from the namelist parameters (srcv(:)%laction) 
    478       !                 define the north fold type of lbc               (srcv(:)%nsgn) 
     508      ! for each field: define the OASIS name                           (ssnd(:)%clname) 
     509      !                 define send or not from the namelist parameters (ssnd(:)%laction) 
     510      !                 define the north fold type of lbc               (ssnd(:)%nsgn) 
    479511       
    480512      ! default definitions of nsnd 
    481       ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1. 
     513      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
    482514          
    483515      !                                                      ! ------------------------- ! 
    … …  
    487519      ssnd(jps_tice)%clname = 'O_TepIce' 
    488520      ssnd(jps_tmix)%clname = 'O_TepMix' 
    489       SELECT CASE( TRIM( cn_snd_temperature ) ) 
     521      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    490522      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE. 
    491       CASE( 'weighted oce and ice' )   ;   ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
     523      CASE( 'weighted oce and ice' ) 
     524         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
     525         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
    492526      CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix             )%laction = .TRUE. 
    493       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' ) 
     527      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    494528      END SELECT 
    495529      
    … …  
    499533      ssnd(jps_albice)%clname = 'O_AlbIce'  
    500534      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    501       SELECT CASE( TRIM( cn_snd_albedo ) ) 
     535      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    502536      CASE( 'none'          )       ! nothing to do 
    503537      CASE( 'weighted ice'  )   ;   ssnd(jps_albice)%laction = .TRUE. 
    504538      CASE( 'mixed oce-ice' )   ;   ssnd(jps_albmix)%laction = .TRUE. 
    505       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' ) 
     539      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 
    506540      END SELECT 
    507541      ! 
    … …  
    509543      !     1. sending mixed oce-ice albedo or 
    510544      !     2. receiving mixed oce-ice solar radiation  
    511       IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr ) == 'mixed oce-ice' ) THEN 
     545      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
    512546         CALL albedo_oce( zaos, zacs ) 
    513547         ! Due to lack of information on nebulosity : mean clear/overcast sky 
    … …  
    518552      !                                                      !  Ice fraction & Thickness !  
    519553      !                                                      ! ------------------------- ! 
    520       ssnd(jps_fice)%clname = 'OIceFrac'    
    521       ssnd(jps_hice)%clname = 'O_IceTck' 
    522       ssnd(jps_hsnw)%clname = 'O_SnwTck' 
    523       IF( k_ice /= 0 )   ssnd(jps_fice)%laction = .TRUE.       ! if ice treated in the ocean (even in climato case) 
    524       IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' )   ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE. 
    525           
     554      ssnd(jps_fice)%clname = 'OIceFrc' 
     555      ssnd(jps_hice)%clname = 'OIceTck' 
     556      ssnd(jps_hsnw)%clname = 'OSnwTck' 
     557      IF( k_ice /= 0 ) THEN 
     558         ssnd(jps_fice)%laction = .TRUE.                  ! if ice treated in the ocean (even in climato case) 
     559! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 
     560         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
     561      ENDIF 
     562 
     563      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
     564      CASE ( 'ice and snow' )  
     565         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
     566         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
     567            ssnd(jps_hice:jps_hsnw)%nct = jpl 
     568         ELSE 
     569            IF ( jpl > 1 ) THEN 
     570               CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
     571            ENDIF 
     572         ENDIF 
     573      CASE ( 'weighted ice and snow' )  
     574         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
     575         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl 
     576      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 
     577      END SELECT 
     578 
    526579      !                                                      ! ------------------------- ! 
    527580      !                                                      !      Surface current      ! 
    … …  
    534587      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold 
    535588 
    536       IF( cn_snd_crt(4) /= 'T' )   CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' ) 
    537       ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid 
    538  
     589      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 
     590         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 
     591      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN   
     592         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 
     593         ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid 
     594      ENDIF 
    539595      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send 
    540       IF( TRIM( cn_snd_crt(2) ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
    541       SELECT CASE( TRIM( cn_snd_crt(1) ) ) 
     596      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
     597      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 
     598      SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    542599      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 
    543600      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
    544601      CASE( 'weighted oce and ice' )   !   nothing to do 
    545602      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
    546       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_crt(1)' ) 
     603      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' ) 
    547604      END SELECT 
    548605 
    549 #if defined key_cpl_carbon_cycle 
    550606      !                                                      ! ------------------------- ! 
    551607      !                                                      !          CO2 flux         ! 
    552608      !                                                      ! ------------------------- ! 
    553       ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(cn_snd_co2) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    554 #endif 
     609      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    555610      ! 
    556611      ! ================================ ! 
    … …  
    636691      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    637692      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    638          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(:,:,jn), nrcvinfo(jn) ) 
     693         IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
    639694      END DO 
    640695 
    … …  
    642697      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  ! 
    643698         !                                                   ! ========================= ! 
    644          ! define frcv(:,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid 
     699         ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 
    645700         ! => need to be done only when we receive the field 
    646701         IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 
    647702            ! 
    648             IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     703            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    649704               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    650705               ! 
    651                CALL geo2oce( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1),   & 
     706               CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1),   & 
    652707                  &          srcv(jpr_otx1)%clgrid, ztx, zty ) 
    653                frcv(:,:,jpr_otx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
    654                frcv(:,:,jpr_oty1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
     708               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
     709               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
    655710               ! 
    656711               IF( srcv(jpr_otx2)%laction ) THEN 
    657                   CALL geo2oce( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2),   & 
     712                  CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1),   & 
    658713                     &          srcv(jpr_otx2)%clgrid, ztx, zty ) 
    659                   frcv(:,:,jpr_otx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
    660                   frcv(:,:,jpr_oty2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     714                  frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
     715                  frcv(jpr_oty2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    661716               ENDIF 
    662717               ! 
    663718            ENDIF 
    664719            ! 
    665             IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
     720            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    666721               !                                                       ! (geographical to local grid -> rotate the components) 
    667                CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    668                frcv(:,:,jpr_otx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     722               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     723               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    669724               IF( srcv(jpr_otx2)%laction ) THEN 
    670                   CALL rot_rep( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    671                ELSE 
    672                   CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     725                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     726               ELSE   
     727                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
    673728               ENDIF 
    674                frcv(:,:,jpr_oty1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
     729               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    675730            ENDIF 
    676731            !                               
    … …  
    678733               DO jj = 2, jpjm1                                          ! T ==> (U,V) 
    679734                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    680                      frcv(ji,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1) ) 
    681                      frcv(ji,jj,jpr_oty1) = 0.5 * ( frcv(ji  ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) ) 
     735                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 
     736                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 
    682737                  END DO 
    683738               END DO 
    684                CALL lbc_lnk( frcv(:,:,jpr_otx1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V',  -1. ) 
     739               CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. ) 
    685740            ENDIF 
    686741            llnewtx = .TRUE. 
    … …  
    691746      ELSE                                                   !   No dynamical coupling   ! 
    692747         !                                                   ! ========================= ! 
    693          frcv(:,:,jpr_otx1) = 0.e0                               ! here simply set to zero  
    694          frcv(:,:,jpr_oty1) = 0.e0                               ! an external read in a file can be added instead 
     748         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero  
     749         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
    695750         llnewtx = .TRUE. 
    696751         ! 
    … …  
    708763!CDIR NOVERRCHK 
    709764               DO ji = fs_2, fs_jpim1   ! vect. opt. 
    710                   zzx = frcv(ji-1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1)  
    711                   zzy = frcv(ji  ,jj-1,jpr_oty1) + frcv(ji,jj,jpr_oty1)  
    712                   frcv(ji,jj,jpr_taum) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
     765                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 
     766                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 
     767                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
    713768               END DO 
    714769            END DO 
    715             CALL lbc_lnk( frcv(:,:,jpr_taum), 'T', 1. ) 
     770            CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 
    716771            llnewtau = .TRUE. 
    717772         ELSE 
    … …  
    722777         ! Stress module can be negative when received (interpolation problem) 
    723778         IF( llnewtau ) THEN  
    724             DO jj = 1, jpj 
    725                DO ji = 1, jpi  
    726                   frcv(ji,jj,jpr_taum) = MAX( 0.0e0, frcv(ji,jj,jpr_taum) ) 
    727                END DO 
    728             END DO 
     779            frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 
    729780         ENDIF 
    730781      ENDIF 
    … …  
    742793!CDIR NOVERRCHK 
    743794               DO ji = 1, jpi  
    744                   frcv(ji,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef ) 
     795                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    745796               END DO 
    746797            END DO 
    747798         ENDIF 
    748       ENDIF 
    749  
    750       ! u(v)tau and taum will be modified by ice model (wndm will be changed by PISCES) 
     799      ELSE 
     800         IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     801      ENDIF 
     802 
     803      ! u(v)tau and taum will be modified by ice model 
    751804      ! -> need to be reset before each call of the ice/fsbc       
    752805      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    753806         ! 
    754          utau(:,:) = frcv(:,:,jpr_otx1)                    
    755          vtau(:,:) = frcv(:,:,jpr_oty1) 
    756          taum(:,:) = frcv(:,:,jpr_taum) 
    757          wndm(:,:) = frcv(:,:,jpr_w10m) 
     807         utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     808         vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     809         taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
    758810         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    759811         !   
    760812      ENDIF 
     813 
     814#if defined key_cpl_carbon_cycle 
     815      !                                                              ! atmosph. CO2 (ppm) 
     816      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
     817#endif 
     818 
    761819      !                                                      ! ========================= ! 
    762820      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
    … …  
    764822         ! 
    765823         !                                                       ! non solar heat flux over the ocean (qns) 
    766          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce) 
    767          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix)   
     824         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     825         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    768826         ! add the latent heat of solid precip. melting 
    769          IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * lfus               
     827         IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus               
    770828 
    771829         !                                                       ! solar flux over the ocean          (qsr) 
    772          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce)  
    773          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(:,:,jpr_qsrmix) 
     830         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     831         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    774832         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
    775833         ! 
    776834         !                                                       ! total freshwater fluxes over the ocean (emp, emps) 
    777          SELECT CASE( TRIM( cn_rcv_emp ) )                                    ! evaporation - precipitation 
     835         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    778836         CASE( 'conservative' ) 
    779             emp(:,:) = frcv(:,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) ) 
     837            emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    780838         CASE( 'oce only', 'oce and ice' ) 
    781             emp(:,:) = frcv(:,:,jpr_oemp) 
     839            emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    782840         CASE default 
    783             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' ) 
     841            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    784842         END SELECT 
    785843         ! 
    786844         !                                                        ! runoffs and calving (added in emp) 
    787          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf)         
    788          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(:,:,jpr_cal) 
     845         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
     846         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    789847         ! 
    790848!!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    791849!!gm                                       at least should be optional... 
    792 !!         IF( TRIM( cn_rcv_rnf ) == 'coupled' ) THEN     ! add to the total freshwater budget 
     850!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    793851!!            ! remove negative runoff 
    794 !!            zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    795 !!            zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     852!!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
     853!!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    796854!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    797855!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    798856!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    799857!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    800 !!               frcv(:,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg 
     858!!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    801859!!            ENDIF      
    802860!!            ! add runoff to e-p  
    803 !!            emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf) 
     861!!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    804862!!         ENDIF 
    805863!!gm  end of internal cooking 
    … …  
    807865         emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp 
    808866   
    809          !                                                           ! 10 m wind speed 
    810          IF( srcv(jpr_w10m)%laction )   wndm(:,:) = frcv(:,:,jpr_w10m) 
    811          ! 
    812 #if defined  key_cpl_carbon_cycle 
    813          !                                                              ! atmosph. CO2 (ppm) 
    814          IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(:,:,jpr_co2) 
    815 #endif 
    816  
    817867      ENDIF 
    818868      ! 
    … …  
    880930            !                                                   ! ======================= ! 
    881931            !   
    882             IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     932            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    883933               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    884                CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1),   & 
     934               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   & 
    885935                  &          srcv(jpr_itx1)%clgrid, ztx, zty ) 
    886                frcv(:,:,jpr_itx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
    887                frcv(:,:,jpr_itx1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
     936               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
     937               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
    888938               ! 
    889939               IF( srcv(jpr_itx2)%laction ) THEN 
    890                   CALL geo2oce( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2),   & 
     940                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   & 
    891941                     &          srcv(jpr_itx2)%clgrid, ztx, zty ) 
    892                   frcv(:,:,jpr_itx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
    893                   frcv(:,:,jpr_ity2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     942                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
     943                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    894944               ENDIF 
    895945               ! 
    896946            ENDIF 
    897947            ! 
    898             IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
     948            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    899949               !                                                       ! (geographical to local grid -> rotate the components) 
    900                CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
    901                frcv(:,:,jpr_itx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     950               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
     951               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    902952               IF( srcv(jpr_itx2)%laction ) THEN 
    903                   CALL rot_rep( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
     953                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
    904954               ELSE 
    905                   CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
     955                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
    906956               ENDIF 
    907                frcv(:,:,jpr_ity1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
     957               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
    908958            ENDIF 
    909959            !                                                   ! ======================= ! 
    910960         ELSE                                                   !     use ocean stress    ! 
    911961            !                                                   ! ======================= ! 
    912             frcv(:,:,jpr_itx1) = frcv(:,:,jpr_otx1) 
    913             frcv(:,:,jpr_ity1) = frcv(:,:,jpr_oty1) 
     962            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 
     963            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 
    914964            ! 
    915965         ENDIF 
    … …  
    934984               DO jj = 2, jpjm1                                   ! (U,V) ==> I 
    935985                  DO ji = 2, jpim1   ! NO vector opt. 
    936                      p_taui(ji,jj) = 0.5 * ( frcv(ji-1,jj  ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) ) 
    937                      p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) ) 
     986                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 
     987                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 
    938988                  END DO 
    939989               END DO 
    … …  
    941991               DO jj = 2, jpjm1                                   ! F ==> I 
    942992                  DO ji = 2, jpim1   ! NO vector opt. 
    943                      p_taui(ji,jj) = frcv(ji-1,jj-1,jpr_itx1)  
    944                      p_tauj(ji,jj) = frcv(ji-1,jj-1,jpr_ity1)   
     993                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 
     994                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 
    945995                  END DO 
    946996               END DO 
    … …  
    948998               DO jj = 2, jpjm1                                   ! T ==> I 
    949999                  DO ji = 2, jpim1   ! NO vector opt. 
    950                      p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji-1,jj  ,jpr_itx1)   & 
    951                         &                   + frcv(ji,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )  
    952                      p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1)   & 
    953                         &                   + frcv(ji,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) ) 
     1000                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj  ,1)   & 
     1001                        &                   + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )  
     1002                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1)   & 
     1003                        &                   + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 
    9541004                  END DO 
    9551005               END DO 
    9561006            CASE( 'I' ) 
    957                p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! I ==> I 
    958                p_tauj(:,:) = frcv(:,:,jpr_ity1) 
     1007               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! I ==> I 
     1008               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    9591009            END SELECT 
    9601010            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN  
    … …  
    9671017               DO jj = 2, jpjm1                                   ! (U,V) ==> F 
    9681018                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    969                      p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj+1,jpr_itx1) ) 
    970                      p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji+1,jj  ,jpr_ity1) ) 
     1019                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj+1,1) ) 
     1020                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1) ) 
    9711021                  END DO 
    9721022               END DO 
    … …  
    9741024               DO jj = 2, jpjm1                                   ! I ==> F 
    9751025                  DO ji = 2, jpim1   ! NO vector opt. 
    976                      p_taui(ji,jj) = frcv(ji+1,jj+1,jpr_itx1)  
    977                      p_tauj(ji,jj) = frcv(ji+1,jj+1,jpr_ity1)   
     1026                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 
     1027                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 
    9781028                  END DO 
    9791029               END DO 
    … …  
    9811031               DO jj = 2, jpjm1                                   ! T ==> F 
    9821032                  DO ji = 2, jpim1   ! NO vector opt. 
    983                      p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1)   & 
    984                         &                   + frcv(ji,jj+1,jpr_itx1) + frcv(ji+1,jj+1,jpr_itx1) )  
    985                      p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji+1,jj  ,jpr_ity1)   & 
    986                         &                   + frcv(ji,jj+1,jpr_ity1) + frcv(ji+1,jj+1,jpr_ity1) ) 
     1033                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1)   & 
     1034                        &                   + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )  
     1035                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1)   & 
     1036                        &                   + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 
    9871037                  END DO 
    9881038               END DO 
    9891039            CASE( 'F' ) 
    990                p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! F ==> F 
    991                p_tauj(:,:) = frcv(:,:,jpr_ity1) 
     1040               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! F ==> F 
     1041               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    9921042            END SELECT 
    9931043            IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN  
    … …  
    9981048            SELECT CASE ( srcv(jpr_itx1)%clgrid ) 
    9991049            CASE( 'U' ) 
    1000                p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! (U,V) ==> (U,V) 
    1001                p_tauj(:,:) = frcv(:,:,jpr_ity1) 
     1050               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V) 
     1051               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    10021052            CASE( 'F' ) 
    10031053               DO jj = 2, jpjm1                                   ! F ==> (U,V) 
    10041054                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1005                      p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj-1,jpr_itx1) ) 
    1006                      p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1) ) 
     1055                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) ) 
     1056                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) ) 
    10071057                  END DO 
    10081058               END DO 
    … …  
    10101060               DO jj = 2, jpjm1                                   ! T ==> (U,V) 
    10111061                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1012                      p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj  ,jpr_itx1) + frcv(ji,jj,jpr_itx1) ) 
    1013                      p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) ) 
     1062                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
     1063                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    10141064                  END DO 
    10151065               END DO 
    … …  
    10171067               DO jj = 2, jpjm1                                   ! I ==> (U,V) 
    10181068                  DO ji = 2, jpim1   ! NO vector opt. 
    1019                      p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1) ) 
    1020                      p_tauj(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_ity1) + frcv(ji  ,jj+1,jpr_ity1) ) 
     1069                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) ) 
     1070                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) ) 
    10211071                  END DO 
    10221072               END DO 
    … …  
    10271077         END SELECT 
    10281078 
    1029          !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency 
    1030          ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1) 
    1031          ! become the i-component and j-component of the stress at the right grid point  
    1032          !!gm  frcv(:,:,jpr_itx1) = p_taui(:,:) 
    1033          !!gm  frcv(:,:,jpr_ity1) = p_tauj(:,:) 
    1034          !!gm 
    10351079      ENDIF 
    10361080      !    
    … …  
    10401084    
    10411085 
    1042    SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  & 
    1043       &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   & 
    1044       &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   & 
    1045       &                        palbi   , psst    , pist                 ) 
     1086   SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
    10461087      !!---------------------------------------------------------------------- 
    1047       !!             ***  ROUTINE sbc_cpl_ice_flx_rcv  *** 
     1088      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
    10481089      !! 
    10491090      !! ** Purpose :   provide the heat and freshwater fluxes of the  
    … …  
    10661107      !!             the atmosphere 
    10671108      !! 
    1068       !!             N.B. - fields over sea-ice are passed in argument so that 
    1069       !!                 the module can be compile without sea-ice. 
    10701109      !!                  - the fluxes have been separated from the stress as 
    10711110      !!                 (a) they are updated at each ice time step compare to 
    … …  
    10781117      !! 
    10791118      !! ** Action  :   update at each nf_ice time step: 
    1080       !!                   pqns_tot, pqsr_tot  non-solar and solar total heat fluxes 
    1081       !!                   pqns_ice, pqsr_ice  non-solar and solar heat fluxes over the ice 
    1082       !!                   pemp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
    1083       !!                   pemp_ice            ice sublimation - solid precipitation over the ice 
    1084       !!                   pdqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
     1119      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes 
     1120      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice 
     1121      !!                   emp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
     1122      !!                   emp_ice            ice sublimation - solid precipitation over the ice 
     1123      !!                   dqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
    10851124      !!                   sprecip             solid precipitation over the ocean   
    10861125      !!---------------------------------------------------------------------- 
    10871126      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1088       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tsn(:,:,1,jp_tem) 
    1089       USE wrk_nemo, ONLY:   ztmp   => wrk_2d_2   ! temporary array 
    1090       USE wrk_nemo, ONLY:   zsnow  => wrk_2d_3   ! snow precipitation  
    1091       USE wrk_nemo, ONLY:   zicefr => wrk_3d_4   ! ice fraction  
    1092       !! 
    1093       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    1094       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1095       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1096       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1097       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1098       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
    1099       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
    1100       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
    1101       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
     1127      USE wrk_nemo, ONLY:   zcptn  => wrk_2d_2   ! rcp * tsn(:,:,1,jp_tem) 
     1128      USE wrk_nemo, ONLY:   ztmp   => wrk_2d_3   ! temporary array 
     1129      USE wrk_nemo, ONLY:   zicefr => wrk_2d_4   ! ice fraction  
     1130      !! 
     1131      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11021132      ! optional arguments, used only in 'mixed oce-ice' case 
    11031133      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    11041134      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
    11051135      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1106       !! 
    1107       INTEGER ::   ji, jj           ! dummy loop indices 
    1108       INTEGER ::   isec, info       ! temporary integer 
    1109       REAL(wp)::   zcoef, ztsurf    ! temporary scalar 
     1136      ! 
     1137      INTEGER ::   jl   ! dummy loop index 
    11101138      !!---------------------------------------------------------------------- 
    11111139 
    1112       IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 4) ) THEN 
     1140      IF( wrk_in_use(2, 2,3,4) ) THEN 
    11131141         CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable')   ;   RETURN 
    11141142      ENDIF 
    11151143 
    1116       zicefr(:,:,1) = 1.- p_frld(:,:,1) 
     1144      zicefr(:,:) = 1.- p_frld(:,:) 
    11171145      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 
    11181146      ! 
    … …  
    11241152      !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    11251153      !                                                           ! solid Precipitation                      (sprecip) 
    1126       SELECT CASE( TRIM( cn_rcv_emp ) ) 
     1154      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11271155      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1128          pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow) 
    1129          pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow) 
    1130          zsnow   (:,:) = frcv(:,:,jpr_snow) 
    1131                            CALL iom_put( 'rain'         , frcv(:,:,jpr_rain)              )   ! liquid precipitation  
    1132          IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) )   ! heat flux from liq. precip.  
    1133          ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1) 
     1156         sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
     1157         tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
     1158         emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
     1159         emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1160                           CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
     1161         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
     1162         ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    11341163                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average) 
    11351164         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave) 
    1136       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 
    1137          pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr)  
    1138          pemp_ice(:,:) = frcv(:,:,jpr_semp) 
    1139          zsnow   (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp) 
     1165      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
     1166         emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1167         emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1168         sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
    11401169      END SELECT 
    1141       psprecip(:,:) = - pemp_ice(:,:) 
    1142       CALL iom_put( 'snowpre'    , zsnow                               )   ! Snow 
    1143       CALL iom_put( 'snow_ao_cea', zsnow(:,:         ) * p_frld(:,:,1) )   ! Snow        over ice-free ocean  (cell average) 
    1144       CALL iom_put( 'snow_ai_cea', zsnow(:,:         ) * zicefr(:,:,1) )   ! Snow        over sea-ice         (cell average) 
    1145       CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) )   ! Sublimation over sea-ice         (cell average) 
     1170 
     1171      CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     1172      CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average) 
     1173      CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average) 
     1174      CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    11461175      !    
    11471176      !                                                           ! runoffs and calving (put in emp_tot) 
    11481177      IF( srcv(jpr_rnf)%laction ) THEN  
    1149          pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) 
    1150                            CALL iom_put( 'runoffs'      , frcv(:,:,jpr_rnf )              )   ! rivers 
    1151          IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(:,:,jpr_rnf ) * zcptn(:,:) )   ! heat flux from rivers 
     1178         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
     1179                           CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
     1180         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    11521181      ENDIF 
    11531182      IF( srcv(jpr_cal)%laction ) THEN  
    1154          pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal) 
    1155          CALL iom_put( 'calving', frcv(:,:,jpr_cal) ) 
     1183         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1184         CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    11561185      ENDIF 
    11571186      ! 
    … …  
    11591188!!gm                                       at least should be optional... 
    11601189!!       ! remove negative runoff                            ! sum over the global domain 
    1161 !!       zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1162 !!       zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     1190!!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
     1191!!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    11631192!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    11641193!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    11651194!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    11661195!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1167 !!          frcv(:,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg 
     1196!!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    11681197!!       ENDIF      
    1169 !!       pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)   ! add runoff to e-p  
     1198!!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    11701199!! 
    11711200!!gm  end of internal cooking 
    11721201 
    1173  
    11741202      !                                                      ! ========================= ! 
    1175       SELECT CASE( TRIM( cn_rcv_qns ) )                      !   non solar heat fluxes   !   (qns) 
     1203      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns) 
    11761204      !                                                      ! ========================= ! 
     1205      CASE( 'oce only' )                                     ! the required field is directly provided 
     1206         qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    11771207      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1178          pqns_tot(:,:  ) = frcv(:,:,jpr_qnsmix) 
    1179          pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 
     1208         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1209         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1210            qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1211         ELSE 
     1212            ! Set all category values equal for the moment 
     1213            DO jl=1,jpl 
     1214               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1215            ENDDO 
     1216         ENDIF 
    11801217      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1181          pqns_tot(:,:  ) =  p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + zicefr(:,:,1) * frcv(:,:,jpr_qnsice) 
    1182          pqns_ice(:,:,1) =  frcv(:,:,jpr_qnsice) 
     1218         qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1219         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1220            DO jl=1,jpl 
     1221               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1222               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1223            ENDDO 
     1224         ELSE 
     1225            DO jl=1,jpl 
     1226               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1227               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1228            ENDDO 
     1229         ENDIF 
    11831230      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    1184          pqns_tot(:,:  ) = frcv(:,:,jpr_qnsmix) 
    1185          pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix)    & 
    1186             &            + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:,1)   & 
    1187             &                                                   +          pist(:,:,1)   * zicefr(:,:,1) ) ) 
     1231! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
     1232         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1233         qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1234            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
     1235            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    11881236      END SELECT 
    1189       ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting 
    1190       pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)                   ! over free ocean  
    1191       IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1237      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting 
     1238      qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean  
     1239      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    11921240!!gm 
    11931241!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
    … …  
    11991247      !                                      
    12001248      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    1201          ztmp(:,:) = frcv(:,:,jpr_cal) * lfus                     ! add the latent heat of iceberg melting  
    1202          pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
    1203          IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) )   ! heat flux from calving 
     1249         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
     1250         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
     1251         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12041252      ENDIF 
    12051253 
    12061254      !                                                      ! ========================= ! 
    1207       SELECT CASE( TRIM( cn_rcv_qsr ) )                      !      solar heat fluxes    !   (qsr) 
     1255      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr) 
    12081256      !                                                      ! ========================= ! 
     1257      CASE( 'oce only' ) 
     1258         qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 
    12091259      CASE( 'conservative' ) 
    1210          pqsr_tot(:,:  ) = frcv(:,:,jpr_qsrmix) 
    1211          pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 
     1260         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1261         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1262            qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1263         ELSE 
     1264            ! Set all category values equal for the moment 
     1265            DO jl=1,jpl 
     1266               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1267            ENDDO 
     1268         ENDIF 
     1269         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1270         qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12121271      CASE( 'oce and ice' ) 
    1213          pqsr_tot(:,:  ) =  p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + zicefr(:,:,1) * frcv(:,:,jpr_qsrice) 
    1214          pqsr_ice(:,:,1) =  frcv(:,:,jpr_qsrice) 
     1272         qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1273         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1274            DO jl=1,jpl 
     1275               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1276               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1277            ENDDO 
     1278         ELSE 
     1279            DO jl=1,jpl 
     1280               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1281               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1282            ENDDO 
     1283         ENDIF 
    12151284      CASE( 'mixed oce-ice' ) 
    1216          pqsr_tot(:,:  ) = frcv(:,:,jpr_qsrmix) 
     1285         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1286! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12171287!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12181288!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1219          pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) )   & 
    1220             &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:,1)   & 
    1221             &                     + palbi         (:,:,1) * zicefr(:,:,1) ) ) 
     1289         qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1290            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
     1291            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12221292      END SELECT 
    12231293      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1224          pqsr_tot(:,:  ) = sbc_dcy( pqsr_tot(:,:  ) ) 
    1225          pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 
    1226       ENDIF 
    1227  
    1228       SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 
     1294         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1295         DO jl=1,jpl 
     1296            qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1297         ENDDO 
     1298      ENDIF 
     1299 
     1300      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
    12291301      CASE ('coupled') 
    1230           pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt) 
     1302         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     1303            dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1304         ELSE 
     1305            ! Set all category values equal for the moment 
     1306            DO jl=1,jpl 
     1307               dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1308            ENDDO 
     1309         ENDIF 
    12311310      END SELECT 
    12321311 
    1233       IF( wrk_not_released(2, 1,2,3)  .OR.   & 
    1234           wrk_not_released(3, 4)      )   CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
     1312      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1313      CASE ('coupled') 
     1314         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     1315         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 
     1316      END SELECT 
     1317 
     1318      IF( wrk_not_released(2, 2,3,4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
    12351319      ! 
    12361320   END SUBROUTINE sbc_cpl_ice_flx 
    … …  
    12491333      USE wrk_nemo, ONLY:   zfr_l => wrk_2d_1   ! 1. - fr_i(:,:) 
    12501334      USE wrk_nemo, ONLY:   ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 
     1335      USE wrk_nemo, ONLY:   ztmp3 => wrk_3d_1 , ztmp4 => wrk_3d_2 
    12511336      USE wrk_nemo, ONLY:   zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 
    12521337      USE wrk_nemo, ONLY:   zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 
    … …  
    12541339      INTEGER, INTENT(in) ::   kt 
    12551340      ! 
    1256       INTEGER ::   ji, jj       ! dummy loop indices 
     1341      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    12571342      INTEGER ::   isec, info   ! local integer 
    12581343      !!---------------------------------------------------------------------- 
    12591344 
    1260       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN 
     1345      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_in_use(3, 1,2)  ) THEN 
    12611346         CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable')   ;   RETURN 
    12621347      ENDIF 
    … …  
    12691354      !                                                      !    Surface temperature    !   in Kelvin 
    12701355      !                                                      ! ------------------------- ! 
    1271       SELECT CASE( cn_snd_temperature) 
     1356      SELECT CASE( sn_snd_temp%cldes) 
    12721357      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1273       CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 
    1274                                            ztmp2(:,:) =   tn_ice(:,:,1)     *  fr_i(:,:) 
    1275       CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 
    1276       CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 
     1358      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
     1359         SELECT CASE( sn_snd_temp%clcat ) 
     1360         CASE( 'yes' )    
     1361            ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1362         CASE( 'no' ) 
     1363            ztmp3(:,:,:) = 0.0 
     1364            DO jl=1,jpl 
     1365               ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1366            ENDDO 
     1367         CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1368         END SELECT 
     1369      CASE( 'mixed oce-ice'        )    
     1370         ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
     1371         DO jl=1,jpl 
     1372            ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1373         ENDDO 
     1374      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    12771375      END SELECT 
    1278       IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, ztmp1, info ) 
    1279       IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp2, info ) 
    1280       IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info ) 
     1376      IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1377      IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
     1378      IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    12811379      ! 
    12821380      !                                                      ! ------------------------- ! 
    … …  
    12841382      !                                                      ! ------------------------- ! 
    12851383      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1286          ztmp1(:,:) = alb_ice(:,:,1) * fr_i(:,:) 
    1287          CALL cpl_prism_snd( jps_albice, isec, ztmp1, info ) 
     1384         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1385         CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 
    12881386      ENDIF 
    12891387      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
    1290          ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:) 
    1291          CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 
     1388         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 
     1389         DO jl=1,jpl 
     1390            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 
     1391         ENDDO 
     1392         CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    12921393      ENDIF 
    12931394      !                                                      ! ------------------------- ! 
    12941395      !                                                      !  Ice fraction & Thickness !  
    12951396      !                                                      ! ------------------------- ! 
    1296       IF( ssnd(jps_fice)%laction )   CALL cpl_prism_snd( jps_fice, isec, fr_i                  , info ) 
    1297       IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info ) 
    1298       IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info ) 
     1397      ! Send ice fraction field  
     1398      SELECT CASE( sn_snd_thick%clcat ) 
     1399         CASE( 'yes' )    
     1400            ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl) 
     1401         CASE( 'no' ) 
     1402            ztmp3(:,:,1) = fr_i(:,:) 
     1403      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1404      END SELECT 
     1405      IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1406 
     1407      ! Send ice and snow thickness field  
     1408      SELECT CASE( sn_snd_thick%cldes) 
     1409      CASE( 'weighted ice and snow' )    
     1410         SELECT CASE( sn_snd_thick%clcat ) 
     1411         CASE( 'yes' )    
     1412            ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1413            ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1414         CASE( 'no' ) 
     1415            ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
     1416            DO jl=1,jpl 
     1417               ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 
     1418               ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 
     1419            ENDDO 
     1420         CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1421         END SELECT 
     1422      CASE( 'ice and snow'         )    
     1423         ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1424         ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1425      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
     1426      END SELECT 
     1427      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
     1428      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
    12991429      ! 
    13001430#if defined key_cpl_carbon_cycle 
    … …  
    13021432      !                                                      !  CO2 flux from PISCES     !  
    13031433      !                                                      ! ------------------------- ! 
    1304       IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, oce_co2 , info ) 
     1434      IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
    13051435      ! 
    13061436#endif 
     1437      !                                                      ! ------------------------- ! 
    13071438      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
    13081439         !                                                   ! ------------------------- ! 
    … …  
    13161447         !                                                              i-1  i   i 
    13171448         !                                                               i      i+1 (for I) 
    1318          SELECT CASE( TRIM( cn_snd_crt(1) ) ) 
     1449         SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    13191450         CASE( 'oce only'             )      ! C-grid ==> T 
    13201451            DO jj = 2, jpjm1 
    … …  
    13941525            END SELECT 
    13951526         END SELECT 
    1396          CALL lbc_lnk( zotx1, 'T', -1. )   ;   CALL lbc_lnk( zoty1, 'T', -1. ) 
     1527         CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
    13971528         ! 
    13981529         ! 
    1399          IF( TRIM( cn_snd_crt(3) ) == 'eastward-northward' ) THEN             ! Rotation of the components 
     1530         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    14001531            !                                                                     ! Ocean component 
    14011532            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    … …  
    14121543         ! 
    14131544         ! spherical coordinates to cartesian -> 2 components to 3 components 
    1414          IF( TRIM( cn_snd_crt(2) ) == 'cartesian' ) THEN 
     1545         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN 
    14151546            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents 
    14161547            ztmp2(:,:) = zoty1(:,:) 
    … …  
    14241555         ENDIF 
    14251556         ! 
    1426          IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info )   ! ocean x current 1st grid 
    1427          IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info )   ! ocean y current 1st grid 
    1428          IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info )   ! ocean z current 1st grid 
     1557         IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     1558         IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     1559         IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
    14291560         ! 
    1430          IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info )   ! ice   x current 1st grid 
    1431          IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, zity1, info )   ! ice   y current 1st grid 
    1432          IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info )   ! ice   z current 1st grid 
     1561         IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
     1562         IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
     1563         IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    14331564         !  
    14341565      ENDIF 
    14351566      ! 
    1436       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) )   CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 
     1567      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_not_released(3, 1,2) )   CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 
    14371568      ! 
    14381569   END SUBROUTINE sbc_cpl_snd 
    … …  
    14591590   END SUBROUTINE sbc_cpl_ice_tau 
    14601591   ! 
    1461    SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  & 
    1462       &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   & 
    1463       &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   & 
    1464       &                        palbi   , psst    , pist                ) 
    1465       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    1466       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1467       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1468       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1469       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1470       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget  [Kg/m2/s] 
    1471       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s] 
    1472       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
    1473       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! solid precipitation          [Kg/m2/s] 
     1592   SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
     1593      REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1] 
    14741594      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    14751595      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    14761596      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    1477       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1478       ! stupid definition to avoid warning message when compiling... 
    1479       pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 
    1480       pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0.  
    1481       pemp_tot(:,:) = 0. ; pemp_ice(:,:)   = 0. ; psprecip(:,:) = 0. 
     1597      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    14821598   END SUBROUTINE sbc_cpl_ice_flx 
    14831599    

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r2977 r3116  
    1616   USE eosbn2          ! equation of state 
    1717   USE sbc_oce         ! surface boundary condition: ocean fields 
     18   USE sbccpl 
    1819   USE fldread         ! read input field 
    1920   USE iom             ! I/O manager library 
    … …  
    9798          
    9899         fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
     100#if defined key_coupled  
     101         a_i(:,:,1) = fr_i(:,:)          
     102#endif 
    99103 
    100104         ! Flux and ice fraction computation 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2715 r3116  
    202202#if defined key_coupled 
    203203         !                                             ! Ice surface fluxes in coupled mode  
    204          IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),                 & 
    205             &                                             qns_tot, qns_ice, qsr_tot , qsr_ice,   & 
    206             &                                             emp_tot, emp_ice, dqns_ice, sprecip,   & 
     204         IF( ksbc == 5 )   THEN 
     205            a_i(:,:,1)=fr_i 
     206            CALL sbc_cpl_ice_flx( frld,                                              & 
    207207            !                                optional arguments, used only in 'mixed oce-ice' case 
    208208            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
     209            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
     210         ENDIF 
    209211#endif 
    210212                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3105 r3116  
    1111   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    1212   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing 
     13   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    3334   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model 
    3435   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model 
     36   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3537   USE sbccpl           ! surface boundary condition: coupled florulation 
    3638   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    … …  
    3941   USE sbcfwb           ! surface boundary condition: freshwater budget 
    4042   USE closea           ! closed sea 
    41    USE bdy_par          ! unstructured open boundary data variables 
    42    USE bdyice           ! unstructured open boundary data  (bdy_ice_frs routine) 
     43   USE bdy_par          ! for lk_bdy 
     44   USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine) 
    4345 
    4446   USE prtctl           ! Print control                    (prt_ctl routine) 
    … …  
    9698        IF( lk_lim2 )   nn_ice      = 2 
    9799        IF( lk_lim3 )   nn_ice      = 3 
     100        IF( lk_cice )   nn_ice      = 4 
    98101      ENDIF 
    99102      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    … …  
    147150         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    148151      ! 
    149       IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
    150          &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' ) 
     152      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     153         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
     154      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
     155         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
     156      IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   & 
     157         &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 
    151158       
    152159      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    … …  
    191198         IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    192199      ENDIF 
     200 
     201      IF( nn_ice == 4 )   CALL cice_sbc_init (nsbc) 
    193202      ! 
    194203   END SUBROUTINE sbc_init 
    … …  
    264273         !                                                       
    265274      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model 
    266          IF( lk_bdy )      CALL bdy_ice_frs  ( kt )                  ! BDY boundary condition 
     275         IF( lk_bdy )      CALL bdy_ice_lim_2( kt )                  ! BDY boundary condition 
    267276         !                                                      
    268277      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model 
     278         ! 
     279      CASE(  4 )   ;       CALL sbc_ice_cice ( kt, nsbc )            ! CICE ice model 
    269280      END SELECT                                               
    270281 
    … …  
    349360            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
    350361      ENDIF 
     362 
     363      IF( kt == nitend )   CALL sbc_final         ! Close down surface module if necessary 
    351364      ! 
    352365   END SUBROUTINE sbc 
     366 
     367   SUBROUTINE sbc_final 
     368      !!--------------------------------------------------------------------- 
     369      !!                    ***  ROUTINE sbc_final  *** 
     370      !!--------------------------------------------------------------------- 
     371 
     372      !----------------------------------------------------------------- 
     373      ! Finalize CICE (if used) 
     374      !----------------------------------------------------------------- 
     375 
     376      IF( nn_ice == 4 )   CALL cice_sbc_final 
     377      ! 
     378   END SUBROUTINE sbc_final 
    353379 
    354380   !!====================================================================== 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90

    r2715 r3116  
    2323   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    2424   USE solmat          ! matrix of the solver 
    25    USE obc_oce         ! Lateral open boundary condition 
    2625   USE in_out_manager  ! I/O manager 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r2715 r3116  
    33   !!                       ***  MODULE  eosbn2  *** 
    44   !! Ocean diagnostic variable : equation of state - in situ and potential density 
    5    !!                                               - Brunt-Vaisala frequency  
     5   !!                                               - Brunt-Vaisala frequency 
    66   !!============================================================================== 
    77   !! History :  OPA  ! 1989-03  (O. Marti)  Original code 
    … …  
    2727   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    2828   !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
    29    !!   eos_alpbet     : calculates the in situ thermal and haline expansion coeff. 
     29   !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio 
    3030   !!   tfreez         : Compute the surface freezing temperature 
    3131   !!   eos_init       : set eos parameters (namelist) 
    … …  
    4141   PRIVATE 
    4242 
    43    !                   !! * Interface  
     43   !                   !! * Interface 
    4444   INTERFACE eos 
    4545      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
    46    END INTERFACE  
     46   END INTERFACE 
    4747   INTERFACE bn2 
    4848      MODULE PROCEDURE eos_bn2 
    49    END INTERFACE  
     49   END INTERFACE 
    5050 
    5151   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules 
    … …  
    6161 
    6262   REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio 
    63     
     63 
    6464   !! * Substitutions 
    6565#  include "domzgr_substitute.h90" 
    … …  
    7575      !!---------------------------------------------------------------------- 
    7676      !!                   ***  ROUTINE eos_insitu  *** 
    77       !!  
    78       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from  
     77      !! 
     78      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
    7979      !!       potential temperature and salinity using an equation of state 
    8080      !!       defined through the namelist parameter nn_eos. 
    … …  
    134134!CDIR NOVERRCHK 
    135135         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    136          !   
     136         ! 
    137137         DO jk = 1, jpkm1 
    138138            DO jj = 1, jpj 
    … …  
    199199      !!---------------------------------------------------------------------- 
    200200      !!                  ***  ROUTINE eos_insitu_pot  *** 
    201       !!            
     201      !! 
    202202      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the 
    203203      !!      potential volumic mass (Kg/m3) from potential temperature and 
    204       !!      salinity fields using an equation of state defined through the  
     204      !!      salinity fields using an equation of state defined through the 
    205205      !!     namelist parameter nn_eos. 
    206206      !! 
    … …  
    230230      !!      nn_eos = 2 : linear equation of state function of temperature and 
    231231      !!               salinity 
    232       !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0  
     232      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
    233233      !!                       = rn_beta * s - rn_alpha * tn - 1. 
    234234      !!              rhop(t,s)  = rho(t,s) 
    … …  
    265265!CDIR NOVERRCHK 
    266266         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    267          !   
     267         ! 
    268268         DO jk = 1, jpkm1 
    269269            DO jj = 1, jpj 
    … …  
    336336      !!                  ***  ROUTINE eos_insitu_2d  *** 
    337337      !! 
    338       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from  
     338      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
    339339      !!      potential temperature and salinity using an equation of state 
    340340      !!      defined through the namelist parameter nn_eos. * 2D field case 
    … …  
    374374      !                                                           ! 2 : salinity               [psu] 
    375375      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m] 
    376       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density  
     376      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
    377377      !! 
    378378      INTEGER  ::   ji, jj                    ! dummy loop indices 
    … …  
    449449         DO jj = 1, jpjm1 
    450450            DO ji = 1, fs_jpim1   ! vector opt. 
    451                prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)  
     451               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 
    452452            END DO 
    453453         END DO 
    … …  
    468468      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time- 
    469469      !!      step of the input arguments 
    470       !!       
     470      !! 
    471471      !! ** Method : 
    472472      !!       * nn_eos = 0  : UNESCO sea water properties 
    … …  
    482482      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 
    483483      !!      The use of potential density to compute N^2 introduces e r r o r 
    484       !!      in the sign of N^2 at great depths. We recommand the use of  
     484      !!      in the sign of N^2 at great depths. We recommand the use of 
    485485      !!      nn_eos = 0, except for academical studies. 
    486486      !!        Macro-tasked on horizontal slab (jk-loop) 
    … …  
    497497      !! 
    498498      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    499       REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars  
     499      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars 
    500500#if defined key_zdfddm 
    501501      REAL(wp) ::   zds   ! local scalars 
    … …  
    504504 
    505505      ! pn2 : interior points only (2=< jk =< jpkm1 ) 
    506       ! --------------------------  
     506      ! -------------------------- 
    507507      ! 
    508508      SELECT CASE( nn_eos ) 
    … …  
    542542                     &                                - 0.121555e-07_wp ) * zh 
    543543                     ! 
    544                   pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2  
     544                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2 
    545545                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   & 
    546546                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) 
    … …  
    565565               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   & 
    566566               &               / fse3w(:,:,jk) * tmask(:,:,jk) 
    567          END DO  
     567         END DO 
    568568#if defined key_zdfddm 
    569569         DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
    570570            DO jj = 1, jpj 
    571571               DO ji = 1, jpi 
    572                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )   
     572                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 
    573573                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 
    574574                  rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
    … …  
    587587 
    588588 
    589    SUBROUTINE eos_alpbet( pts, palph, pbeta ) 
    590       !!---------------------------------------------------------------------- 
    591       !!                 ***  ROUTINE ldf_slp_grif  *** 
    592       !! 
    593       !! ** Purpose :   Calculates the thermal and haline expansion coefficients at T-points.  
    594       !! 
    595       !! ** Method  :   calculates alpha and beta at T-points  
     589   SUBROUTINE eos_alpbet( pts, palpbet, beta0 ) 
     590      !!---------------------------------------------------------------------- 
     591      !!                 ***  ROUTINE eos_alpbet  *** 
     592      !! 
     593      !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points 
     594      !! 
     595      !! ** Method  :   calculates alpha / beta ratio at T-points 
    596596      !!       * nn_eos = 0  : UNESCO sea water properties 
    597       !!         The brunt-vaisala frequency is computed using the polynomial 
    598       !!      polynomial expression of McDougall (1987): 
    599       !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 
    600       !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 
    601       !!      computed and used in zdfddm module : 
    602       !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 
     597      !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial 
     598      !!                       polynomial expression of McDougall (1987). 
     599      !!                       Scalar beta0 is returned = 1. 
    603600      !!       * nn_eos = 1  : linear equation of state (temperature only) 
    604       !!            N^2 = grav * rn_alpha * dk[ t ]/e3w 
     601      !!                       The ratio is undefined, so we return alpha as palpbet 
     602      !!                       Scalar beta0 is returned = 0. 
    605603      !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    606       !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 
    607       !!       * nn_eos = 3  : Jackett JAOT 2003 ??? 
    608       !! 
    609       !! ** Action  : - palph, pbeta : thermal and haline expansion coeff. at T-point 
    610       !!---------------------------------------------------------------------- 
    611       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity 
    612       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff. 
    613       ! 
     604      !!                       The alpha/beta ratio is returned as ralpbet 
     605      !!                       Scalar beta0 is returned = 1. 
     606      !! 
     607      !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points 
     608      !!            :   beta0   : 1. or 0. 
     609      !!---------------------------------------------------------------------- 
     610      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity 
     611      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio 
     612      REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T) 
     613      !! 
    614614      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    615       REAL(wp) ::   zt, zs, zh   ! local scalars  
     615      REAL(wp) ::   zt, zs, zh   ! local scalars 
    616616      !!---------------------------------------------------------------------- 
    617617      ! 
    … …  
    624624                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature 
    625625                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35) 
    626                   zh = fsdept(ji,jj,jk)              ! depth in meters  
    627                   ! 
    628                   pbeta(ji,jj,jk) = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt   & 
    629                      &                                        - 0.301985e-05_wp ) * zt   & 
    630                      &           + 0.785567e-03_wp                                       & 
    631                      &           + (     0.515032e-08_wp * zs                            & 
    632                      &                 + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs   & 
    633                      &           + ( (   0.121551e-17_wp * zh                            & 
    634                      &                 - 0.602281e-15_wp * zs                            & 
    635                      &                 - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh   & 
    636                      &                                        + 0.408195e-10_wp   * zs   & 
    637                      &             + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt   & 
    638                      &                                        - 0.121555e-07_wp ) * zh 
    639                      ! 
    640                   palph(ji,jj,jk) = - pbeta(ji,jj,jk) *                             & 
    641                       &     ((( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   & 
    642                       &                                  - 0.203814e-03_wp ) * zt   & 
    643                       &                                  + 0.170907e-01_wp ) * zt   & 
    644                       &   + 0.665157e-01_wp                                         & 
    645                       &   +     ( - 0.678662e-05_wp * zs                            & 
    646                       &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    647                       &   +   ( ( - 0.302285e-13_wp * zh                            & 
    648                       &           - 0.251520e-11_wp * zs                            & 
    649                       &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    650                       &           - 0.164759e-06_wp * zs                            & 
    651                       &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    652                       &                                  + 0.380374e-04_wp ) * zh) 
     626                  zh = fsdept(ji,jj,jk)               ! depth in meters 
     627                  ! 
     628                  palpbet(ji,jj,jk) =                                              & 
     629                     &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   & 
     630                     &                                  - 0.203814e-03_wp ) * zt   & 
     631                     &                                  + 0.170907e-01_wp ) * zt   & 
     632                     &   + 0.665157e-01_wp                                         & 
     633                     &   +     ( - 0.678662e-05_wp * zs                            & 
     634                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
     635                     &   +   ( ( - 0.302285e-13_wp * zh                            & 
     636                     &           - 0.251520e-11_wp * zs                            & 
     637                     &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
     638                     &           - 0.164759e-06_wp * zs                            & 
     639                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
     640                     &                                  + 0.380374e-04_wp ) * zh 
    653641               END DO 
    654642            END DO 
    655643         END DO 
    656          ! 
    657       CASE ( 1 ) 
    658          palph(:,:,:) = - rn_alpha 
    659          pbeta(:,:,:) =   0._wp 
    660          ! 
    661       CASE ( 2 ) 
    662          palph(:,:,:) = - rn_alpha 
    663          pbeta(:,:,:) =   rn_beta 
     644         beta0 = 1._wp 
     645         ! 
     646      CASE ( 1 )              !==  Linear formulation = F( temperature )  ==! 
     647         palpbet(:,:,:) = rn_alpha 
     648         beta0 = 0._wp 
     649         ! 
     650      CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==! 
     651         palpbet(:,:,:) = ralpbet 
     652         beta0 = 1._wp 
    664653         ! 
    665654      CASE DEFAULT 
    … …  
    747736 
    748737   !!====================================================================== 
    749 END MODULE eosbn2   
     738END MODULE eosbn2 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r2715 r3116  
    9393      ! 
    9494      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   & 
    95          &              CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )          ! add the eiv transport (if necessary) 
     95         &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary) 
    9696      ! 
    9797      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport       
    … …  
    100100 
    101101      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    102       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
    103       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
    104       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL  
    105       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
    106       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
    107       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
     102      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     103      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
     104      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL  
     105      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
     106      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
     107      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
    108108      ! 
    109109      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    110          CALL tra_adv_cen2  ( kt, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     110         CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    111111         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               & 
    112112            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    113          CALL tra_adv_tvd   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     113         CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    114114         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               & 
    115115            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    116          CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )           
     116         CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )           
    117117         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               & 
    118118            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    119          CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     119         CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    120120         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               & 
    121121            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    122          CALL tra_adv_ubs   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     122         CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    123123         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
    124124            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    125          CALL tra_adv_qck   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     125         CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    126126         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
    127127            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2977 r3116  
    5353CONTAINS 
    5454 
    55    SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,        & 
     55   SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn,     & 
    5656      &                                 ptb, ptn, pta, kjpt   )  
    5757      !!---------------------------------------------------------------------- 
    … …  
    116116      ! 
    117117      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     118      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    118119      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    119120      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    … …  
    135136      ENDIF 
    136137 
    137       IF( kt == nit000 )  THEN 
     138      IF( kt == kit000 )  THEN 
    138139         IF(lwp) WRITE(numout,*) 
    139140         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype 
    … …  
    141142         IF(lwp) WRITE(numout,*) 
    142143         ! 
    143          ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    144          IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 
     144         IF (.not. ALLOCATED(upsmsk))THEN 
     145             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
     146             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 
     147         ENDIF 
     148 
    145149         ! 
    146150         upsmsk(:,:) = 0._wp                             ! not upstream by default 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r2715 r3116  
    4545CONTAINS 
    4646 
    47    SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype ) 
     47   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype ) 
    4848      !!---------------------------------------------------------------------- 
    4949      !!                  ***  ROUTINE tra_adv_eiv  *** 
    … …  
    6969#endif 
    7070      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
     71      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index 
    7172      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    7273      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components  
    … …  
    9091      ENDIF 
    9192 
    92       IF( kt == nit000 )  THEN 
     93      IF( kt == kit000 )  THEN 
    9394         IF(lwp) WRITE(numout,*) 
    9495         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' 
    … …  
    203204   !!---------------------------------------------------------------------- 
    204205CONTAINS 
    205    SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )              ! Empty routine 
     206   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )              ! Empty routine 
    206207      INTEGER  ::   kt     
     208      INTEGER  ::   kit000     
    207209      CHARACTER(len=3) ::   cdtype 
    208210      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2977 r3116  
    4444CONTAINS 
    4545 
    46    SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, & 
     46   SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 
    4747      &                                        ptb, pta, kjpt ) 
    4848      !!---------------------------------------------------------------------- 
    … …  
    6666      ! 
    6767      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     68      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    6869      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    6970      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    … …  
    8384      ENDIF 
    8485 
    85       IF( kt == nit000 )  THEN 
     86      IF( kt == kit000 )  THEN 
    8687         IF(lwp) WRITE(numout,*) 
    8788         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2977 r3116  
    4242CONTAINS 
    4343 
    44    SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     44   SUBROUTINE tra_adv_muscl2( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    4545      &                                         ptb, ptn, pta, kjpt ) 
    4646      !!---------------------------------------------------------------------- 
    … …  
    6464      !! 
    6565      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     66      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    6667      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    6768      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    … …  
    8182      ENDIF 
    8283 
    83       IF( kt == nit000 )  THEN 
     84      IF( kt == kit000 )  THEN 
    8485         IF(lwp) WRITE(numout,*) 
    8586         IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2977 r3116  
    4545CONTAINS 
    4646 
    47    SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     47   SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    4848      &                                       ptb, ptn, pta, kjpt ) 
    4949      !!---------------------------------------------------------------------- 
    … …  
    8282      !!---------------------------------------------------------------------- 
    8383      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     84      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    8485      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    8586      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    … …  
    9091      !!---------------------------------------------------------------------- 
    9192 
    92       IF( kt == nit000 )  THEN 
     93      IF( kt == kit000 )  THEN 
    9394         IF(lwp) WRITE(numout,*) 
    9495         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2715 r3116  
    5151CONTAINS 
    5252 
    53    SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     53   SUBROUTINE tra_adv_tvd ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    5454      &                                       ptb, ptn, pta, kjpt ) 
    5555      !!---------------------------------------------------------------------- 
    … …  
    7171      ! 
    7272      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     73      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    7374      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    7475      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    … …  
    8990      ENDIF 
    9091 
    91       IF( kt == nit000 )  THEN 
     92      IF( kt == kit000 )  THEN 
    9293         IF(lwp) WRITE(numout,*) 
    9394         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r2715 r3116  
    4040CONTAINS 
    4141 
    42    SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn,      & 
     42   SUBROUTINE tra_adv_ubs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    4343      &                                       ptb, ptn, pta, kjpt ) 
    4444      !!---------------------------------------------------------------------- 
    … …  
    8080      ! 
    8181      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     82      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    8283      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    8384      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    … …  
    9798      ENDIF 
    9899 
    99       IF( kt == nit000 )  THEN 
     100      IF( kt == kit000 )  THEN 
    100101         IF(lwp) WRITE(numout,*) 
    101102         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r2715 r3116  
    106106      !!---------------------------------------------------------------------- 
    107107 
    108       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     108      IF( l_trdtra )   THEN                        !* Save ta and sa trends 
    109109         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    110110         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    111111      ENDIF 
    112112 
    113       IF( l_bbl )   CALL bbl( kt, 'TRA' )       !* bbl coef. and transport (only if not already done in trcbbl) 
    114  
    115  
    116       IF( nn_bbl_ldf == 1 ) THEN                !* Diffusive bbl 
     113      IF( l_bbl )  CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
     114 
     115 
     116      IF( nn_bbl_ldf == 1 ) THEN                   !* Diffusive bbl 
    117117         CALL tra_bbl_dif( tsb, tsa, jpts ) 
    118118         IF( ln_ctl )  & 
    … …  
    311311 
    312312 
    313    SUBROUTINE bbl( kt, cdtype ) 
     313   SUBROUTINE bbl( kt, kit000, cdtype ) 
    314314      !!---------------------------------------------------------------------- 
    315315      !!                  ***  ROUTINE bbl  *** 
    … …  
    343343      ! 
    344344      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
     345      INTEGER         , INTENT(in   ) ::   kit000          ! first time step index 
    345346      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    346347      !! 
    … …  
    389390      ENDIF 
    390391      
    391       IF( kt == nit000 )  THEN 
     392      IF( kt == kit000 )  THEN 
    392393         IF(lwp)  WRITE(numout,*) 
    393394         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 
    … …  
    537538      !! 
    538539      !! ** Method  :   Read the nambbl namelist and check the parameters 
    539       !!              called by nemo_init at the first timestep (nit000) 
     540      !!              called by nemo_init at the first timestep (kit000) 
    540541      !!---------------------------------------------------------------------- 
    541542      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2977 r3116  
    7070 
    7171      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    72       CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian 
     72      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian 
    7373      CASE ( 1 )                                                                              ! rotated laplacian 
    7474         IF( ln_traldf_grif ) THEN                                                           
    75                        CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator 
     75                       CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator 
    7676         ELSE                                                                                 
    77                        CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator 
    78          ENDIF 
    79       CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian 
    80       CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap. 
     77                       CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator 
     78         ENDIF 
     79      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian 
     80      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap. 
    8181         ! 
    8282      CASE ( -1 )                                ! esopa: test all possibility with control print 
    83          CALL tra_ldf_lap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
     83         CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
    8484         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    8585         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    8686         IF( ln_traldf_grif ) THEN 
    87             CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
     87            CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
    8888         ELSE 
    89             CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )   
     89            CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )   
    9090         ENDIF 
    9191         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 
    9292         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    93          CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
     93         CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
    9494         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               & 
    9595         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    96          CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        )  
     96         CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        )  
    9797         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
    9898         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    … …  
    299299      ! Compute the ldf trends 
    300300      ! ---------------------- 
    301       CALL tra_ldf( nit000+1 )      ! horizontal components (+1: no more init) 
    302       CALL tra_zdf( nit000   )      ! vertical component (if necessary nit000 to performed the init) 
     301      CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init) 
     302      CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init) 
    303303 
    304304      ! finalise the computation and recover all arrays 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r2715 r3116  
    4747CONTAINS 
    4848  
    49    SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv,      & 
     49   SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv,      & 
    5050      &                                  ptb, pta, kjpt )   
    5151      !!---------------------------------------------------------------------- 
    … …  
    7979      !! 
    8080      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     81      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    8182      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    8283      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    9394      ENDIF 
    9495 
    95       IF( kt == nit000 )  THEN 
     96      IF( kt == kit000 )  THEN 
    9697         IF(lwp) WRITE(numout,*) 
    9798         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r2715 r3116  
    4242CONTAINS 
    4343 
    44    SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt ) 
     44   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                 ***  ROUTINE tra_ldf_bilapg  *** 
    … …  
    7070      ! 
    7171      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index 
     72      INTEGER         , INTENT(in   )                      ::   kit000   ! first time step index 
    7273      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator) 
    7374      INTEGER         , INTENT(in   )                      ::   kjpt     ! number of tracers 
    … …  
    8283      ENDIF 
    8384 
    84       IF( kt == nit000 )  THEN 
     85      IF( kt == kit000 )  THEN 
    8586         IF(lwp) WRITE(numout,*) 
    8687         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype 
    … …  
    345346   !!---------------------------------------------------------------------- 
    346347CONTAINS 
    347    SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt )      ! Empty routine 
     348   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )      ! Empty routine 
     349      INTEGER :: kt, kit000 
    348350      CHARACTER(len=3) ::   cdtype 
    349351      REAL, DIMENSION(:,:,:,:) ::   ptb, pta 
    350       WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt 
     352      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', & 
     353        &         kt, kit000, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt 
    351354   END SUBROUTINE tra_ldf_bilapg 
    352355#endif 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r2715 r3116  
    4949CONTAINS 
    5050 
    51    SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv,              & 
     51   SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,              & 
    5252      &                                ptb, pta, kjpt, pahtb0 ) 
    5353      !!---------------------------------------------------------------------- 
    … …  
    9696      ! 
    9797      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     98      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    9899      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    99100      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    116117      ENDIF 
    117118 
    118       IF( kt == nit000 )  THEN 
     119      IF( kt == kit000 )  THEN 
    119120         IF(lwp) WRITE(numout,*) 
    120121         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    … …  
    301302   !!---------------------------------------------------------------------- 
    302303CONTAINS 
    303    SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine 
     304   SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine 
     305      INTEGER:: kt, kit000 
    304306      CHARACTER(len=3) ::   cdtype 
    305307      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels 
    306308      REAL, DIMENSION(:,:,:,:) ::   ptb, pta 
    307       WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, pgu(1,1,1), pgv(1,1,1),   & 
    308          &                                                             ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 
     309      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   & 
     310         &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 
    309311   END SUBROUTINE tra_ldf_iso 
    310312#endif 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2715 r3116  
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!====================================================================== 
    6    !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)   
     6   !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec) 
    77   !!                !          Griffies operator version adapted from traldf_iso.F90 
    88   !!---------------------------------------------------------------------- 
    … …  
    1111   !!   'key_ldfslp'               slope of the lateral diffusive direction 
    1212   !!---------------------------------------------------------------------- 
    13    !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component   
    14    !!                       of the Griffies iso-neutral laplacian operator  
     13   !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component 
     14   !!                       of the Griffies iso-neutral laplacian operator 
    1515   !!---------------------------------------------------------------------- 
    1616   USE oce             ! ocean dynamics and active tracers 
    … …  
    3434   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only) 
    3535   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2 
    36    REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt                 !  atypic workspace 
     36   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d               !: vertical tracer gradient at 2 levels 
    3737 
    3838   !! * Substitutions 
    … …  
    4848CONTAINS 
    4949 
    50   SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv,              & 
     50  SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              & 
    5151       &                                   ptb, pta, kjpt, pahtb0 ) 
    5252      !!---------------------------------------------------------------------- 
    5353      !!                  ***  ROUTINE tra_ldf_iso_grif  *** 
    5454      !! 
    55       !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive  
    56       !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and  
     55      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
     56      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 
    5757      !!      add it to the general trend of tracer equation. 
    5858      !! 
    59       !! ** Method  :   The horizontal component of the lateral diffusive trends  
     59      !! ** Method  :   The horizontal component of the lateral diffusive trends 
    6060      !!      is provided by a 2nd order operator rotated along neural or geopo- 
    6161      !!      tential surfaces to which an eddy induced advection can be added 
    … …  
    6767      !! 
    6868      !!      2nd part :  horizontal fluxes of the lateral mixing operator 
    69       !!      ========     
     69      !!      ======== 
    7070      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ] 
    7171      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ] 
    … …  
    9595      ! 
    9696      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     97      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    9798      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    9899      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    99100      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    100101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    102103      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
    103104      ! 
    … …  
    108109      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    109110      REAL(wp) ::  zcoef0, zbtr                  !   -      - 
    110       !REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdkt           ! 2D+1 workspace 
    111111      ! 
    112112      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv 
    … …  
    121121         CALL ctl_stop('tra_ldf_iso_grif: requested workspace arrays unavailable.')   ;   RETURN 
    122122      ENDIF 
    123       ! ARP - line below uses 'bounds re-mapping' which is only defined in 
    124       ! Fortran 2003 and up. We would be OK if code was written to use 
    125       ! zdkt(:,:,1:2) instead as then wouldn't need to re-map bounds. 
    126       ! As it is, we make zdkt a module array and allocate it in _alloc(). 
    127       !zdkt(1:jpi,1:jpj,0:1) => wrk_3d_9(:,:,1:2) 
    128  
    129       IF( kt == nit000 )  THEN 
     123 
     124      IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) )  THEN 
    130125         IF(lwp) WRITE(numout,*) 
    131126         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype 
    132          IF(lwp) WRITE(numout,*) '                   WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL' 
    133127         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    134          ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr ) 
     128         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr ) 
    135129         IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    136130         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 
    137131         IF( ln_traldf_gdia ) THEN 
    138             ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    139             IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    140             IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 
     132            IF (.not. ALLOCATED(psix_eiv))THEN 
     133                ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
     134                IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
     135                IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 
     136            ENDIF 
    141137         ENDIF 
    142138      ENDIF 
    143139 
    144140      !!---------------------------------------------------------------------- 
    145       !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv  
     141      !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv 
    146142      !!---------------------------------------------------------------------- 
    147143 
    148 !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads 
     144      !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads 
    149145 
    150146      ah_wslp2(:,:,:) = 0._wp 
    … …  
    159155               DO jj = 1, jpjm1 
    160156                  DO ji = 1, fs_jpim1 
     157                     ze1ur = 1._wp / e1u(ji,jj) 
    161158                     ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
    162159                     zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    163                      zah   = fsahtu(ji,jj,jk)                                  !  fsaht(ji+ip,jj,jk) 
     160                     zah   = fsahtu(ji,jj,jk)                                  ! fsaht(ji+ip,jj,jk) 
    164161                     zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    165                      zslope2 = zslope_skew - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp) 
     162                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
     163                     ! (do this by *adding* gradient of depth) 
     164                     zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp) 
    166165                     zslope2 = zslope2 *zslope2 
    167166                     ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp)    & 
    168167                        &                     + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2 
    169168                     IF( ln_traldf_gdia ) THEN 
    170                         zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        !fsaeit(ji+ip,jj,jk)*zslope_skew 
     169                        zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew           ! fsaeit(ji+ip,jj,jk)*zslope_skew 
    171170                        psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 
    172171                     ENDIF 
    … …  
    182181               DO jj = 1, jpjm1 
    183182                  DO ji=1,fs_jpim1 
     183                     ze2vr = 1._wp / e2v(ji,jj) 
    184184                     ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 
    185185                     zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    186                      zah   = fsahtu(ji,jj,jk)                                       !fsaht(ji,jj+jp,jk) 
     186                     zah   = fsahtv(ji,jj,jk)                                  ! fsaht(ji,jj+jp,jk) 
    187187                     zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    188                      zslope2 = zslope_skew - ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp) 
     188                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
     189                     !    (do this by *adding* gradient of depth) 
     190                     zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp) 
    189191                     zslope2 = zslope2 * zslope2 
    190192                     ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp)   & 
    191193                        &                     + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2 
    192194                     IF( ln_traldf_gdia ) THEN 
    193                         zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew     !fsaeit(ji,jj+jp,jk)*zslope_skew 
     195                        zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew           ! fsaeit(ji,jj+jp,jk)*zslope_skew 
    194196                        psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 
    195197                     ENDIF 
    … …  
    207209         zftu(:,:,:) = 0._wp 
    208210         zftv(:,:,:) = 0._wp 
    209          !                                                
     211         ! 
    210212         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
    211213            DO jj = 1, jpjm1 
    … …  
    216218            END DO 
    217219         END DO 
    218          IF( ln_zps ) THEN                               ! partial steps: correction at the last level 
     220         IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level 
    219221# if defined key_vectopt_loop 
    220222            DO jj = 1, 1 
    … …  
    224226               DO ji = 1, jpim1 
    225227# endif 
    226                   zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)           
    227                   zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)       
     228                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
     229                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    228230               END DO 
    229231            END DO 
    … …  
    237239            ! 
    238240            !                    !==  Vertical tracer gradient at level jk and jk+1 
    239             zdkt(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
     241            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
    240242            ! 
    241             !                          ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    242             IF( jk == 1 ) THEN   ;   zdkt(:,:,0) = zdkt(:,:,1) 
    243             ELSE                 ;   zdkt(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
     243            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1) 
     244            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
     245            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
    244246            ENDIF 
    245247 
    246             IF( .NOT. l_triad_iso ) THEN 
    247                triadi = triadi_g 
    248                triadj = triadj_g 
    249             ENDIF 
    250  
    251             DO ip = 0, 1              !==  Horizontal & vertical fluxes 
    252                DO kp = 0, 1 
    253                   DO jj = 1, jpjm1 
    254                      DO ji = 1, fs_jpim1 
    255                         ze1ur = 1._wp / e1u(ji,jj) 
    256                         zdxt = zdit(ji,jj,jk) * ze1ur 
    257                         ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
    258                         zdzt  = zdkt(ji+ip,jj,kp) * ze3wr 
    259                         zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    260                         zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
    261  
    262                         zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    263                         zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ???? 
    264                         zah_slp  = zah * zslope_iso 
    265                         zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew 
    266                         zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
    267                         ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
     248 
     249            IF (ln_botmix_grif) THEN 
     250               DO ip = 0, 1              !==  Horizontal & vertical fluxes 
     251                  DO kp = 0, 1 
     252                     DO jj = 1, jpjm1 
     253                        DO ji = 1, fs_jpim1 
     254                           ze1ur = 1._wp / e1u(ji,jj) 
     255                           zdxt  = zdit(ji,jj,jk) * ze1ur 
     256                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
     257                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
     258                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
     259                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
     260 
     261                           zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
     262                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells 
     263                           zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ???? 
     264                           zah_slp  = zah * zslope_iso 
     265                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew 
     266                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
     267                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
     268                        END DO 
    268269                     END DO 
    269270                  END DO 
    270271               END DO 
    271             END DO 
    272  
    273             DO jp = 0, 1 
    274                DO kp = 0, 1 
    275                   DO jj = 1, jpjm1 
    276                      DO ji = 1, fs_jpim1 
    277                         ze2vr = 1._wp / e2v(ji,jj) 
    278                         zdyt = zdjt(ji,jj,jk) * ze2vr 
    279                         ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
    280                         zdzt = zdkt(ji,jj+jp,kp) * ze3wr 
    281                         zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    282                         zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    283                         zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    284                         zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)         !fsaht(ji,jj+jp,jk) 
    285                         zah_slp = zah * zslope_iso 
    286                         zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew    !fsaeit(ji,jj+jp,jk)*zslope_skew 
    287                         zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
    288                         ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
     272 
     273               DO jp = 0, 1 
     274                  DO kp = 0, 1 
     275                     DO jj = 1, jpjm1 
     276                        DO ji = 1, fs_jpim1 
     277                           ze2vr = 1._wp / e2v(ji,jj) 
     278                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
     279                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
     280                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
     281                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
     282                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
     283                           zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     284                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells 
     285                           zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)  ! fsaht(ji,jj+jp,jk) 
     286                           zah_slp = zah * zslope_iso 
     287                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew 
     288                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
     289                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
     290                        END DO 
    289291                     END DO 
    290292                  END DO 
    291293               END DO 
    292             END DO 
    293  
    294             !                        !==  divergence and add to the general trend  ==! 
     294            ELSE 
     295               DO ip = 0, 1              !==  Horizontal & vertical fluxes 
     296                  DO kp = 0, 1 
     297                     DO jj = 1, jpjm1 
     298                        DO ji = 1, fs_jpim1 
     299                           ze1ur = 1._wp / e1u(ji,jj) 
     300                           zdxt  = zdit(ji,jj,jk) * ze1ur 
     301                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 
     302                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
     303                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
     304                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
     305 
     306                           zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
     307                           ! ln_botmix_grif is .F. mask zah for bottom half cells 
     308                           zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! fsaht(ji+ip,jj,jk)   ===>>  ???? 
     309                           zah_slp  = zah * zslope_iso 
     310                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew 
     311                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
     312                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
     313                        END DO 
     314                     END DO 
     315                  END DO 
     316               END DO 
     317 
     318               DO jp = 0, 1 
     319                  DO kp = 0, 1 
     320                     DO jj = 1, jpjm1 
     321                        DO ji = 1, fs_jpim1 
     322                           ze2vr = 1._wp / e2v(ji,jj) 
     323                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
     324                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 
     325                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
     326                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
     327                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
     328                           zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     329                           ! ln_botmix_grif is .F. mask zah for bottom half cells 
     330                           zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! fsaht(ji,jj+jp,jk) 
     331                           zah_slp = zah * zslope_iso 
     332                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew 
     333                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
     334                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
     335                        END DO 
     336                     END DO 
     337                  END DO 
     338               END DO 
     339            END IF 
     340            !                          !==  divergence and add to the general trend  ==! 
    295341            DO jj = 2 , jpjm1 
    296                DO ji = fs_2, fs_jpim1   ! vector opt. 
     342               DO ji = fs_2, fs_jpim1  ! vector opt. 
    297343                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    298344                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (   zftu(ji-1,jj,jk) - zftu(ji,jj,jk)   & 
    … …  
    303349         END DO 
    304350         ! 
    305          DO jk = 1, jpkm1            !== Divergence of vertical fluxes added to the general tracer trend 
     351         DO jk = 1, jpkm1              !== Divergence of vertical fluxes added to the general tracer trend 
    306352            DO jj = 2, jpjm1 
    307                DO ji = fs_2, fs_jpim1   ! vector opt. 
     353               DO ji = fs_2, fs_jpim1  ! vector opt. 
    308354                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
    309355                     &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    … …  
    312358         END DO 
    313359         ! 
    314          !                            ! "Poleward" diffusive heat or salt transports (T-S case only) 
     360         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    315361         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    316362            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names 
    … …  
    320366#if defined key_diaar5 
    321367         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    322             z2d(:,:) = 0._wp  
    323             zztmp = rau0 * rcp  
     368            z2d(:,:) = 0._wp 
     369            zztmp = rau0 * rcp 
    324370            DO jk = 1, jpkm1 
    325371               DO jj = 2, jpjm1 
    326372                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    327                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     373                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
    328374                  END DO 
    329375               END DO 
    … …  
    332378            CALL lbc_lnk( z2d, 'U', -1. ) 
    333379            CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    334             z2d(:,:) = 0._wp  
     380            z2d(:,:) = 0._wp 
    335381            DO jk = 1, jpkm1 
    336382               DO jj = 2, jpjm1 
    337383                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    338                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     384                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
    339385                  END DO 
    340386               END DO 
    … …  
    342388            z2d(:,:) = zztmp * z2d(:,:) 
    343389            CALL lbc_lnk( z2d, 'V', -1. ) 
    344             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     390            CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in j-direction 
    345391         END IF 
    346392#endif 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2715 r3116  
    4444CONTAINS 
    4545 
    46    SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,      & 
     46   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv,      & 
    4747      &                                ptb, pta, kjpt )  
    4848      !!---------------------------------------------------------------------- 
    … …  
    6666      ! 
    6767      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     68      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    6869      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    6970      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    7778      !!---------------------------------------------------------------------- 
    7879       
    79       IF( kt == nit000 )  THEN 
     80      IF( kt == kit000 )  THEN 
    8081         IF(lwp) WRITE(numout,*) 
    8182         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 
    8283         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
    8384         ! 
    84          ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 
    85          IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    86          IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 
    87          ! 
    88          e1ur(:,:) = e2u(:,:) / e1u(:,:) 
    89          e2vr(:,:) = e1v(:,:) / e2v(:,:) 
     85         IF( .NOT. ALLOCATED( e1ur ) ) THEN 
     86            ! This routine may be called for both active and passive tracers.  
     87            ! Allocate and set saved arrays on first call only. 
     88            ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 
     89            IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     90            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 
     91            ! 
     92            e1ur(:,:) = e2u(:,:) / e1u(:,:) 
     93            e2vr(:,:) = e1v(:,:) / e2v(:,:) 
     94         ENDIF 
    9095      ENDIF 
    9196 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2977 r3116  
    3636   USE obc_oce 
    3737   USE obctra          ! open boundary condition (obc_tra routine) 
    38    USE bdy_par         ! Unstructured open boundary condition (bdy_tra_frs routine) 
    39    USE bdytra          ! Unstructured open boundary condition (bdy_tra_frs routine) 
     38   USE bdy_oce 
     39   USE bdytra          ! open boundary condition (bdy_tra routine) 
    4040   USE in_out_manager  ! I/O manager 
    4141   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4242   USE prtctl          ! Print control 
    4343   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    44    USE obc_oce  
    4544#if defined key_agrif 
    4645   USE agrif_opa_update 
    … …  
    8079      !!              - Apply lateral boundary conditions on (ta,sa)  
    8180      !!             at the local domain   boundaries through lbc_lnk call,  
    82       !!             at the radiative open boundaries (lk_obc=T),  
    83       !!             at the relaxed   open boundaries (lk_bdy=T), and 
     81      !!             at the one-way open boundaries (lk_obc=T),  
    8482      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8583      !! 
    … …  
    114112#endif 
    115113#if defined key_bdy  
    116       IF( lk_bdy )   CALL bdy_tra_frs( kt )  ! BDY open boundaries 
     114      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    117115#endif 
    118116#if defined key_agrif 
    … …  
    139137      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    140138         ! 
    141          IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)      
    142          ELSE                 ;   CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level  
     139         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)      
     140         ELSE                 ;   CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level  
    143141         ENDIF 
    144142      ENDIF  
    … …  
    168166 
    169167 
    170    SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt ) 
     168   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 
    171169      !!---------------------------------------------------------------------- 
    172170      !!                   ***  ROUTINE tra_nxt_fix  *** 
    … …  
    192190      !!---------------------------------------------------------------------- 
    193191      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
     192      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index 
    194193      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
    195194      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
    … …  
    203202      !!---------------------------------------------------------------------- 
    204203 
    205       IF( kt == nit000 )  THEN 
     204      IF( kt == kit000 )  THEN 
    206205         IF(lwp) WRITE(numout,*) 
    207          IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping' 
     206         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype 
    208207         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    209208      ENDIF 
    … …  
    234233 
    235234 
    236    SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt ) 
     235   SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 
    237236      !!---------------------------------------------------------------------- 
    238237      !!                   ***  ROUTINE tra_nxt_vvl  *** 
    … …  
    259258      !!---------------------------------------------------------------------- 
    260259      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
     260      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index 
    261261      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
    262262      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
    … …  
    271271      !!---------------------------------------------------------------------- 
    272272 
    273       IF( kt == nit000 ) THEN 
     273      IF( kt == kit000 ) THEN 
    274274         IF(lwp) WRITE(numout,*) 
    275          IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping' 
     275         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype 
    276276         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    277277      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r2715 r3116  
    7676 
    7777      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    78       CASE ( 0 )    ;    CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme  
    79       CASE ( 1 )    ;    CALL tra_zdf_imp( kt, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme  
     78      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme  
     79      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme  
    8080      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    81          CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 
     81         CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 
    8282         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               & 
    8383         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    84          CALL tra_zdf_imp( kt, 'TRA', r2dtra,            tsb, tsa, jpts )  
     84         CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts )  
    8585         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               & 
    8686         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r2715 r3116  
    4848CONTAINS 
    4949 
    50    SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp,   & 
     50   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kn_zdfexp,   & 
    5151      &                                ptb , pta      , kjpt ) 
    5252      !!---------------------------------------------------------------------- 
    … …  
    7777      ! 
    7878      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index 
     79      INTEGER                              , INTENT(in   ) ::   kit000      ! first time step index 
    7980      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator) 
    8081      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers 
    … …  
    9394      ENDIF 
    9495 
    95       IF( kt == nit000 )  THEN 
     96      IF( kt == kit000 )  THEN 
    9697         IF(lwp) WRITE(numout,*) 
    9798         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r2715 r3116  
    5555CONTAINS 
    5656  
    57    SUBROUTINE tra_zdf_imp( kt, cdtype, p2dt, ptb, pta, kjpt )  
     57   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt )  
    5858      !!---------------------------------------------------------------------- 
    5959      !!                  ***  ROUTINE tra_zdf_imp  *** 
    … …  
    7979      ! 
    8080      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
     81      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    8182      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    8283      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
    … …  
    9394      ENDIF 
    9495 
    95       IF( kt == nit000 )  THEN 
     96      IF( kt == kit000 )  THEN 
    9697         IF(lwp)WRITE(numout,*) 
    9798         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r2715 r3116  
    3636   REAL(wp) ::   rn_bfrien = 30._wp      ! local factor to enhance coefficient bfri 
    3737   LOGICAL  ::   ln_bfr2d  = .false.     ! logical switch for 2D enhancement 
    38     
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  bfrcoef2d   ! 2D bottom drag coefficient 
     38   LOGICAL , PUBLIC                            ::  ln_bfrimp = .false.  ! logical switch for implicit bottom friction 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  bfrcoef2d            ! 2D bottom drag coefficient 
    4040 
    4141   !! * Substitutions 
    … …  
    142142      REAL(wp) ::  zfru, zfrv         !    -         - 
    143143      !! 
    144       NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien 
     144      NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien, ln_bfrimp 
    145145      !!---------------------------------------------------------------------- 
    146146 
    … …  
    156156      !                              ! allocate zdfbfr arrays 
    157157      IF( zdf_bfr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' ) 
     158 
     159      !                              ! Make sure ln_zdfexp=.false. when use implicit bfr 
     160      IF( ln_bfrimp .AND. ln_zdfexp ) THEN 
     161         IF(lwp) THEN 
     162            WRITE(numout,*) 
     163            WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.' 
     164            WRITE(numout,*) '         but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!' 
     165            WRITE(ctmp1,*)  '         bad ln_bfrimp value = .true.'  
     166            CALL ctl_stop( ctmp1 ) 
     167         END IF 
     168      END IF 
    158169 
    159170      SELECT CASE (nn_bfr) 
    … …  
    207218         ! 
    208219      END SELECT 
     220      IF(lwp) WRITE(numout,*) '      implicit bottom friction switch                ln_bfrimp  = ', ln_bfrimp 
    209221      ! 
    210222      ! Basic stability check on bottom friction coefficient 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3104 r3116  
    2727   !!            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 
    29    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     29   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     30   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    3031   !!---------------------------------------------------------------------- 
    3132 
    … …  
    4647   USE domain          ! domain initialization             (dom_init routine) 
    4748   USE obcini          ! open boundary cond. initialization (obc_ini routine) 
    48    USE bdyini          ! unstructured open boundary cond. initialization (bdy_init routine) 
     49   USE bdyini          ! open boundary cond. initialization (bdy_init routine) 
     50   USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine) 
     51   USE bdytides        ! open boundary cond. initialization (tide_init routine) 
    4952   USE istate          ! initial state setting          (istate_init routine) 
    5053   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    … …  
    6770   USE c1d             ! 1D configuration 
    6871   USE step_c1d        ! Time stepping loop for the 1D configuration 
     72   USE dynnept         ! simplified form of Neptune effect 
    6973#if defined key_top 
    7074   USE trcini          ! passive tracer initialisation 
    … …  
    246250      IF( Agrif_Root() ) THEN 
    247251         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
     252#if defined key_nemocice_decomp 
     253         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     254#else 
    248255         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
     256#endif 
    249257         jpk = jpkdta                                             ! third dim 
    250258         jpim1 = jpi-1                                            ! inner domain indices 
    … …  
    293301                            CALL     dom_init   ! Domain 
    294302 
     303      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
     304 
    295305      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    296306 
    297307      IF( lk_obc        )   CALL     obc_init   ! Open boundaries  
    298       IF( lk_bdy        )   CALL     bdy_init   ! Unstructured open boundaries 
     308      IF( lk_bdy        )   CALL     bdy_init       ! Open boundaries initialisation 
     309      IF( lk_bdy        )   CALL     bdy_dta_init   ! Open boundaries initialisation of external data arrays 
     310      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing 
     311 
     312                            CALL flush(numout) 
     313                            CALL dyn_nept_init  ! simplified form of Neptune effect 
     314                            CALL flush(numout) 
    299315 
    300316                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    … …  
    623639   END SUBROUTINE factorise 
    624640 
     641#if defined key_mpp_mpi 
     642   SUBROUTINE nemo_northcomms 
     643      !!====================================================================== 
     644      !!                     ***  ROUTINE  nemo_northcomms  *** 
     645      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging 
     646      !!===================================================================== 
     647      !!---------------------------------------------------------------------- 
     648      !!  
     649      !! ** Purpose :   Initialization of the northern neighbours lists. 
     650      !!---------------------------------------------------------------------- 
     651      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  
     652      !!---------------------------------------------------------------------- 
     653 
     654      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices 
     655      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange 
     656      INTEGER ::   northcomms_alloc        ! allocate return status 
     657      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace 
     658      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace 
     659 
     660      IF(lwp) WRITE(numout,*) 
     661      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 
     662      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     663 
     664      !!---------------------------------------------------------------------- 
     665      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 
     666      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 
     667      IF( northcomms_alloc /= 0 ) THEN 
     668         WRITE(numout,cform_war) 
     669         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 
     670         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 
     671      ENDIF 
     672      nsndto = 0 
     673      isendto = -1 
     674      ijpj   = 4 
     675      ! 
     676      ! This routine has been called because ln_nnogather has been set true ( nammpp ) 
     677      ! However, these first few exchanges have to use the mpi_allgather method to 
     678      ! establish the neighbour lists to use in subsequent peer to peer exchanges. 
     679      ! Consequently, set l_north_nogather to be false here and set it true only after 
     680      ! the lists have been established. 
     681      ! 
     682      l_north_nogather = .FALSE. 
     683      ! 
     684      ! Exchange and store ranks on northern rows 
     685 
     686      DO jtyp = 1,4 
     687 
     688         lrankset = .FALSE. 
     689         znnbrs = narea 
     690         SELECT CASE (jtyp) 
     691            CASE(1) 
     692               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points 
     693            CASE(2) 
     694               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point 
     695            CASE(3) 
     696               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point 
     697            CASE(4) 
     698               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point 
     699         END SELECT 
     700 
     701         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
     702            DO jj = nlcj-ijpj+1, nlcj 
     703               ij = jj - nlcj + ijpj 
     704               DO ji = 1,jpi 
     705                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
     706               &     lrankset(INT(znnbrs(ji,jj))) = .true. 
     707               END DO 
     708            END DO 
     709 
     710            DO jj = 1,jpnij 
     711               IF ( lrankset(jj) ) THEN 
     712                  nsndto(jtyp) = nsndto(jtyp) + 1 
     713                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
     714                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
     715                  &                 ' jpmaxngh will need to be increased ') 
     716                  ENDIF 
     717                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
     718               ENDIF 
     719            END DO 
     720         ENDIF 
     721 
     722      END DO 
     723 
     724      ! 
     725      ! Type 5: I-point 
     726      ! 
     727      ! ICE point exchanges may involve some averaging. The neighbours list is 
     728      ! built up using two exchanges to ensure that the whole stencil is covered. 
     729      ! lrankset should not be reset between these 'J' and 'K' point exchanges 
     730 
     731      jtyp = 5 
     732      lrankset = .FALSE. 
     733      znnbrs = narea  
     734      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 
     735 
     736      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
     737         DO jj = nlcj-ijpj+1, nlcj 
     738            ij = jj - nlcj + ijpj 
     739            DO ji = 1,jpi 
     740               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
     741            &     lrankset(INT(znnbrs(ji,jj))) = .true. 
     742         END DO 
     743        END DO 
     744      ENDIF 
     745 
     746      znnbrs = narea  
     747      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 
     748 
     749      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 
     750         DO jj = nlcj-ijpj+1, nlcj 
     751            ij = jj - nlcj + ijpj 
     752            DO ji = 1,jpi 
     753               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) & 
     754            &       lrankset( INT(znnbrs(ji,jj))) = .true. 
     755            END DO 
     756         END DO 
     757 
     758         DO jj = 1,jpnij 
     759            IF ( lrankset(jj) ) THEN 
     760               nsndto(jtyp) = nsndto(jtyp) + 1 
     761               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
     762                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
     763               &                 ' jpmaxngh will need to be increased ') 
     764               ENDIF 
     765               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
     766            ENDIF 
     767         END DO 
     768         ! 
     769         ! For northern row areas, set l_north_nogather so that all subsequent exchanges  
     770         ! can use peer to peer communications at the north fold 
     771         ! 
     772         l_north_nogather = .TRUE. 
     773         ! 
     774      ENDIF 
     775      DEALLOCATE( znnbrs ) 
     776      DEALLOCATE( lrankset ) 
     777 
     778   END SUBROUTINE nemo_northcomms 
     779#else 
     780   SUBROUTINE nemo_northcomms      ! Dummy routine 
     781      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 
     782   END SUBROUTINE nemo_northcomms 
     783#endif 
    625784   !!====================================================================== 
    626785END MODULE nemogcm 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r2977 r3116  
    3535   !! free surface                                      !  before  ! now    ! after  ! 
    3636   !! ------------                                      !  fields  ! fields ! trends ! 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m] 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 
    39    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::            sshf_n          !: sea surface height at f-point [m] 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m] 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::            sshf_n          !: sea surface height at f-point [m] 
    4141   ! 
    4242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r2715 r3116  
    8181   !!--------------------------------------------------------------------- 
    8282#             include "par_POMME_R025.h90" 
     83#elif defined key_amm_12km 
     84   !!--------------------------------------------------------------------- 
     85   !!   'key_amm_12km':                    Atlantic Margin Model : AMM12km  
     86   !!--------------------------------------------------------------------- 
     87#             include "par_AMM_12km.h90" 
    8388#else 
    8489   !!--------------------------------------------------------------------- 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/step.F90

    r3104 r3116  
    3737#endif 
    3838   USE asminc           ! assimilation increments    (tra_asm_inc, dyn_asm_inc routines) 
     39   USE dynnept          ! simplified form of Neptune effect 
    3940 
    4041   IMPLICIT NONE 
    … …  
    99100      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries 
    100101      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries 
    101       IF( lk_bdy     )   CALL bdy_dta_frs( kstp )     ! update dynamic and tracer data for FRS conditions (BDY) 
     102      IF( lk_bdy     )   CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries 
    102103 
    103104      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    219220      IF(  ln_asmiau .AND. & 
    220221         & ln_dyninc       )   CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
     222      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified) 
    221223                               CALL dyn_adv( kstp )         ! advection (vector or flux form) 
    222224                               CALL dyn_vor( kstp )         ! vorticity term including Coriolis 
    223225                               CALL dyn_ldf( kstp )         ! lateral mixing 
     226      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! add Neptune velocities (simplified) 
    224227#if defined key_agrif 
    225228      IF(.NOT. Agrif_Root())   CALL Agrif_Sponge_dyn        ! momemtum sponge 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r3104 r3116  
    5252   USE obcrad           ! open boundary cond. radiation    (obc_rad routine) 
    5353 
    54    USE bdy_par          ! unstructured open boundary data variables 
    55    USE bdydta           ! unstructured open boundary data  (bdy_dta routine) 
     54   USE bdy_par          ! for lk_bdy 
     55   USE bdydta           ! open boundary condition data     (bdy_dta routine) 
    5656 
    5757   USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r3028 r3116  
    119119      ENDIF 
    120120 
    121       IF( kt == nit000 )  THEN         ! Computation of decay coeffcient 
     121      IF( kt == nittrc000 )  THEN         ! Computation of decay coeffcient 
    122122         zdemi   = 5730._wp 
    123123         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r2977 r3116  
    3838      !! 
    3939      !! ** Method  :   Read the namcfc namelist and check the parameter  
    40       !!       values called at the first timestep (nit000) 
     40      !!       values called at the first timestep (nittrc000) 
    4141      !! 
    4242      !! ** input   :   Namelist namcfc 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2977 r3116  
    9696      ENDIF 
    9797 
    98       IF( kt == nit000 )   CALL trc_cfc_cst 
     98      IF( kt == nittrc000 )   CALL trc_cfc_cst 
    9999 
    100100      ! Temporal interpolation 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r3028 r3116  
    8989      ENDIF 
    9090 
    91       IF( kt == nit000 ) THEN 
     91      IF( kt == nittrc000 ) THEN 
    9292         IF(lwp) WRITE(numout,*) 
    9393         IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r2977 r3116  
    6262      !!--------------------------------------------------------------------- 
    6363 
    64       IF( kt == nit000 ) THEN 
     64      IF( kt == nittrc000 ) THEN 
    6565         IF(lwp) WRITE(numout,*) 
    6666         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r2715 r3116  
    7272      END IF 
    7373 
    74       IF( kt == nit000 ) THEN 
     74      IF( kt == nittrc000 ) THEN 
    7575         IF(lwp) WRITE(numout,*) 
    7676         IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r3028 r3116  
    6767      !!--------------------------------------------------------------------- 
    6868 
    69       IF( kt == nit000 ) THEN 
     69      IF( kt == nittrc000 ) THEN 
    7070         IF(lwp) WRITE(numout,*) 
    7171         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r2977 r3116  
    6666      !!--------------------------------------------------------------------- 
    6767 
    68       IF( kt == nit000 )                                                   CALL trc_sms_pisces_init       ! Initialization (first time-step only) 
     68      IF( kt == nittrc000 )                                                CALL trc_sms_pisces_init       ! Initialization (first time-step only) 
    6969      IF( ln_rsttr .AND. ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers 
    70  
    7170 
    7271      IF( ndayflxtr /= nday_year ) THEN      ! New days 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90

    r2761 r3116  
    449449 
    450450      dtsed = rdt 
    451       nitsed000 = nit000 
     451      nitsed000 = nittrc000 
    452452      nitsedend = nitend 
    453453#if ! defined key_sed_off 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90

    r2528 r3116  
    3535 
    3636 
    37       IF( kt == nit000 ) CALL sed_init       ! Initialization of sediment model 
     37      IF( kt == nittrc000 ) CALL sed_init       ! Initialization of sediment model 
    3838 
    3939                         CALL sed_stp( kt )  ! Time stepping of Sediment model 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90

    r2761 r3116  
    5656      ! Initialisation 
    5757      ! -----------------  
    58       IF( kt == nit000 )   ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 
     58      IF( kt == nittrc000 )   ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 
    5959 
    6060      ! Define frequency of output and means 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r2715 r3116  
    3535   INTEGER ::   nadv   ! choice of the type of advection scheme 
    3636   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    37    !                                                    ! except at nit000 (=rdttra) if neuler=0 
     37   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
    3838 
    3939   !! * Substitutions 
    … …  
    8080      ENDIF 
    8181 
    82       IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options 
     82      IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    8383 
    8484#if ! defined key_pisces 
    85       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
     85      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    8686         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    87       ELSEIF( kt <= nit000 + nn_dttrc ) THEN          ! at nit000 or nit000+1 
     87      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    8888         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    8989      ENDIF 
    … …  
    102102      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom 
    103103 
    104       !                                                   ! add the eiv transport (if necessary) 
    105       IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' ) 
     104      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
     105         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 
    106106      ! 
    107107      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    108       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    109       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    110       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL  
    111       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
    112       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
    113       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
     108      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
     109      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
     110      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL  
     111      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
     112      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
     113      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    114114      ! 
    115115      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    116          CALL tra_adv_cen2  ( kt, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
     116         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
    117117         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    118118                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    119          CALL tra_adv_tvd   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     119         CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    120120         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    121121                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    122          CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )           
     122         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )           
    123123         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    124124                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    125          CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     125         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    126126         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    127127                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    128          CALL tra_adv_ubs   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     128         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    129129         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    130130                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    131          CALL tra_adv_qck   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     131         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    132132         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    133133                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r2528 r3116  
    5656      !!---------------------------------------------------------------------- 
    5757 
    58       IF( .NOT. lk_offline ) THEN 
    59          CALL bbl( kt, 'TRC' )         ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
    60          l_bbl = .FALSE.               ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
     58      IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN 
     59         CALL bbl( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
     60         l_bbl = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
    6161      ENDIF 
    6262 
    6363      IF( l_trdtrc )  THEN 
    64          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )   ! temporary save of trends 
     64         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 
    6565         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    6666      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r2715 r3116  
    9494      ! 0. Initialization (first time-step only) 
    9595      !    -------------- 
    96       IF( kt == nit000 ) CALL trc_dmp_init 
     96      IF( kt == nittrc000 ) CALL trc_dmp_init 
    9797 
    9898      IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )   ! temporary save of trends 
    … …  
    173173      !! 
    174174      !! ** Method  :   read the nammbf namelist and check the parameters 
    175       !!              called by trc_dmp at the first timestep (nit000) 
     175      !!              called by trc_dmp at the first timestep (nittrc000) 
    176176      !!---------------------------------------------------------------------- 
    177177 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r2977 r3116  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  trcldf  *** 
    4    !! Ocean Passive tracers : lateral diffusive trends  
     4   !! Ocean Passive tracers : lateral diffusive trends 
    55   !!===================================================================== 
    66   !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     7   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_top 
    … …  
    2222   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine) 
    2323   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine) 
     24   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    2425   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    2526   USE trdmod_oce 
    … …  
    3031   PRIVATE 
    3132 
    32    PUBLIC   trc_ldf    ! called by step.F90  
     33   PUBLIC   trc_ldf    ! called by step.F90 
    3334   !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    3435   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
    … …  
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     42   !! $Id$ 
    4243   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4344   !!---------------------------------------------------------------------- 
    … …  
    4849      !!---------------------------------------------------------------------- 
    4950      !!                  ***  ROUTINE tra_ldf  *** 
    50       !!  
     51      !! 
    5152      !! ** Purpose :   compute the lateral ocean tracer physics. 
    5253      !! 
    … …  
    5960      !!---------------------------------------------------------------------- 
    6061 
    61       IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options 
     62      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options 
    6263 
    6364      rldf = rldf_rat 
    6465 
    65       IF( l_trdtrc )  THEN  
     66      IF( l_trdtrc )  THEN 
    6667         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )  ! temporary save of trends 
    6768         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    … …  
    6970 
    7071      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    71       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             )  ! iso-level laplacian 
    72       CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtrb_0 )  ! rotated laplacian  
    73       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             )  ! iso-level bilaplacian 
    74       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra             )  ! s-coord. horizontal bilaplacian 
     72      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian 
     73      CASE ( 1 )                                                                                            ! rotated laplacian 
     74                       IF( ln_traldf_grif ) THEN 
     75                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     76                       ELSE 
     77                          CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     78                       ENDIF 
     79      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian 
     80      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    7581         ! 
    7682      CASE ( -1 )                                     ! esopa: test all possibility with control print 
    77          CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             ) 
     83         CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
    7884         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    7985                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    80          CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtrb_0 ) 
     86         IF( ln_traldf_grif ) THEN 
     87            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     88         ELSE 
     89            CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     90         ENDIF 
    8191         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    8292                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    83          CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             ) 
     93         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
    8494         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    8595                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    86          CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra             ) 
     96         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            ) 
    8797         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    8898                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    … …  
    94104           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
    95105        END DO 
    96         DEALLOCATE( ztrtrd )  
     106        DEALLOCATE( ztrtrd ) 
    97107      ENDIF 
    98108      !                                          ! print mean trends (used for debugging) 
    … …  
    108118      !!---------------------------------------------------------------------- 
    109119      !!                  ***  ROUTINE ldf_ctl  *** 
    110       !!  
     120      !! 
    111121      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
    112122      !! 
    113123      !! ** Method  :   set nldf from the namtra_ldf logicals 
    114       !!      nldf == -2   No lateral diffusion   
     124      !!      nldf == -2   No lateral diffusion 
    115125      !!      nldf == -1   ESOPA test: ALL operators are used 
    116126      !!      nldf ==  0   laplacian operator 
    … …  
    119129      !!      nldf ==  3   Rotated bilaplacian 
    120130      !!---------------------------------------------------------------------- 
    121       INTEGER ::   ioptio, ierr         ! temporary integers  
     131      INTEGER ::   ioptio, ierr         ! temporary integers 
    122132      !!---------------------------------------------------------------------- 
    123133 
    … …  
    126136      !  Define the lateral mixing oparator for tracers 
    127137      ! =============================================== 
    128      
     138 
    129139      !                               ! control the input 
    130140      ioptio = 0 
    … …  
    167177         ENDIF 
    168178         IF ( ln_zps ) THEN             ! z-coordinate 
    169             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed  
     179            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    170180            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    171181            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r2715 r3116  
    9696      !!---------------------------------------------------------------------- 
    9797 
    98       IF( kt == nit000 .AND. lwp ) THEN 
     98      IF( kt == nittrc000 .AND. lwp ) THEN 
    9999         WRITE(numout,*) 
    100100         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    … …  
    119119 
    120120      ! set time step size (Euler/Leapfrog) 
    121       IF( neuler == 0 .AND. kt ==  nit000) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nit000             (Euler) 
    122       ELSEIF( kt <= nit000 + 1 )           THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     121      IF( neuler == 0 .AND. kt ==  nittrc000) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
     122      ELSEIF( kt <= nittrc000 +  nn_dttrc )           THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
    123123      ENDIF 
    124124 
    … …  
    129129      ENDIF 
    130130      ! Leap-Frog + Asselin filter time stepping 
    131       IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
    132          !                                             ! (only swap) 
     131      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
     132         !                                                ! (only swap) 
    133133         DO jn = 1, jptra 
    134134            DO jk = 1, jpkm1 
    … …  
    139139      ELSE 
    140140         ! Leap-Frog + Asselin filter time stepping 
    141          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
    142          ELSE                ;   CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     141         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt,nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
     142         ELSE                ;   CALL tra_nxt_fix( kt,nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
    143143         ENDIF 
    144144      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r3003 r3116  
    5353      !!---------------------------------------------------------------------- 
    5454 
    55       IF( kt == nit000 ) THEN 
     55      IF( kt == nittrc000 ) THEN 
    5656         IF(lwp) WRITE(numout,*) 
    5757         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r2715 r3116  
    7272      END IF 
    7373 
    74       IF( kt == nit000 ) THEN 
     74      IF( kt == nittrc000 ) THEN 
    7575         IF(lwp) WRITE(numout,*) 
    7676         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r2715 r3116  
    3232      !                                ! defined from ln_zdf...  namlist logicals) 
    3333   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    34       !                                                 ! except at nit000 (=rdttra) if neuler=0 
     34      !                                                 ! except at nittrc000 (=rdttra) if neuler=0 
    3535 
    3636   !! * Substitutions 
    … …  
    6969      !!--------------------------------------------------------------------- 
    7070 
    71       IF( kt == nit000 )   CALL zdf_ctl          ! initialisation & control of options 
     71      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options 
    7272 
    7373#if ! defined key_pisces 
    74       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
     74      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    7575         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    76       ELSEIF( kt <= nit000 + nn_dttrc ) THEN          ! at nit000 or nit000+1 
     76      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+nn_dttrc 
    7777         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    7878      ENDIF 
    … …  
    8888      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    8989      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    90          CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
     90         CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
    9191         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    9292                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    93          CALL tra_zdf_imp( kt, 'TRC', r2dt,                trb, tra, jptra )  
     93         CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
    9494         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    9595                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    96       CASE ( 0 ) ;  CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    97       CASE ( 1 ) ;  CALL tra_zdf_imp( kt, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
     96      CASE ( 0 ) ;  CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
     97      CASE ( 1 ) ;  CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
    9898 
    9999      END SELECT 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r2715 r3116  
    475475      ! II.1 Set before values of vertically averages passive tracers 
    476476      ! ------------------------------------------------------------- 
    477       IF( kt > nit000 ) THEN 
     477      IF( kt > nittrc000 ) THEN 
    478478         DO jn = 1, jptra 
    479479            IF( ln_trdtrc(jn) ) THEN 
    … …  
    497497      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window     
    498498      ! ------------------------------------------------------------------------ 
    499       IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
     499      IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
    500500         ! 
    501501         DO jn = 1, jptra 
    … …  
    560560      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc 
    561561 
    562       itmod = kt - nit000 + 1 
     562      itmod = kt - nittrc000 + 1 
    563563      it    = kt 
    564564 
    … …  
    980980      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 
    981981      ! ------------------------------------------------------------------------ 
    982       IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
     982      IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
    983983         ! 
    984984         tmltrd_csum_ub_bio (:,:,:) = 0.e0 
    … …  
    10861086 
    10871087      ! define time axis 
    1088       itmod = kt - nit000 + 1 
     1088      itmod = kt - nittrc000 + 1 
    10891089      it    = kt 
    10901090 
    … …  
    13311331      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    13321332      IF(lwp) WRITE(numout,*)' '   
    1333       IF(lwp) WRITE(numout,*)' Date 0 used :', nit000                  & 
     1333      IF(lwp) WRITE(numout,*)' Date 0 used :', nittrc000               & 
    13341334           &   ,' YEAR ', nyear, ' MONTH ', nmonth,' DAY ', nday       & 
    13351335           &   ,'Julian day : ', zjulian 
    … …  
    13601360            CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 
    13611361            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1362                &        1, jpi, 1, jpj, nit000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
     1362               &        1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
    13631363       
    13641364            !-- Define the ML depth variable 
    … …  
    13731373          CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 
    13741374          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1375              &             1, jpi, 1, jpj, nit000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 
     1375             &             1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 
    13761376#endif 
    13771377 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90

    r2528 r3116  
    5050      !!---------------------------------------------------------------------- 
    5151 
    52       IF( kt == nit000 ) THEN 
     52      IF( kt == nittrc000 ) THEN 
    5353!         IF(lwp)WRITE(numout,*) 
    5454!         IF(lwp)WRITE(numout,*) 'trd_mod_trc:' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r2977 r3116  
    108108   USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m) 
    109109   USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m) 
     110# if ! defined key_zco 
    110111   USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ??? 
    111112   USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m) 
    … …  
    118119   USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m) 
    119120   USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m) 
    120  
     121# endif 
    121122   USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag 
    122123   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag 
    … …  
    190191   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    191192   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
     193   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 
     194   USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s) 
     195   USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1] 
     196   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
     197   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
     198   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
     199   USE oce , ONLY :   sshu_n  =>    sshu_n  !: sea surface height at u-point [m]    
     200   USE oce , ONLY :   sshu_b  =>    sshu_b  !: sea surface height at u-point [m]    
     201   USE oce , ONLY :   sshu_a  =>    sshu_a  !: sea surface height at u-point [m]    
     202   USE oce , ONLY :   sshv_n  =>    sshv_n  !: sea surface height at v-point [m]    
     203   USE oce , ONLY :   sshv_b  =>    sshv_b  !: sea surface height at v-point [m]    
     204   USE oce , ONLY :   sshv_a  =>    sshv_a  !: sea surface height at v-point [m]    
     205   USE oce , ONLY :   sshf_n  =>    sshf_n  !: sea surface height at v-point [m]    
    192206   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion 
    193207#if defined key_offline 
    … …  
    206220   USE sbc_oce , ONLY :   qsr        =>    qsr        !: penetrative solar radiation (w m-2)   
    207221   USE sbc_oce , ONLY :   emp        =>    emp        !: freshwater budget: volume flux               [Kg/m2/s] 
     222   USE sbc_oce , ONLY :   emp_b      =>    emp_b      !: freshwater budget: volume flux               [Kg/m2/s] 
    208223   USE sbc_oce , ONLY :   emps       =>    emps       !: freshwater budget: concentration/dillution   [Kg/m2/s] 
    209224   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s] 
    … …  
    216231   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.)  
    217232   USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.) 
     233   USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s] 
    218234 
    219235   USE trc_oce 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r2997 r3116  
    5454   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
    5555   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag 
     56   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
    5657 
    5758   !! information for outputs 
    … …  
    9899   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit 
    99100 
     101   !! variables to average over physics over passive tracer sub-steps. 
     102   !! ---------------------------------------------------------------- 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_tm       !: i-horizontal velocity average     [m/s] 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s] 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s] 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s] 
     107# if defined key_zdfddm 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
     109# endif 
     110#if defined key_ldfslp 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points 
     115#endif 
     116#if defined key_trabbl 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm  !: j-direction slope at u-, w-points 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm  !: j-direction slope at u-, w-points 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm  !: j-direction slope at u-, w-points 
     121#endif 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm     !: average ssh for the now step [m] 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_tm   !: average ssh for the now step [m] 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_tm   !: average ssh for the now step [m] 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]   
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m]   
     127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_b_hold !:hold sshb from the beginning of each sub-stepping[m]  
     128 
     129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  rnf_tm     !: river runoff 
     130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm   !: depth in metres to the bottom of the relevant grid box 
     131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_tm    !: mixed layer depth average [m] 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s] 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s] 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emps_tm    !: freshwater budget:concentration/dilution [Kg/m2/s] 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m]   
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m] 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  wndm_tm    !: 10m wind average [m] 
     138   ! 
     139#if defined key_traldf_c3d 
     140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 3D coefficients ** at T-,U-,V-,W-points 
     141#elif defined key_traldf_c2d 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 2D coefficients ** at T-,U-,V-,W-points 
     143#elif defined key_traldf_c1d 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 1D coefficients ** at T-,U-,V-,W-points 
     145#else 
     146   REAL(wp), PUBLIC                                        ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 0D coefficients ** at T-,U-,V-,W-points 
     147#endif 
     148   ! 
     149#if defined key_traldf_eiv 
     150#  if defined key_traldf_c3d 
     151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 3D coefficients ** 
     152#  elif defined key_traldf_c2d 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 2D coefficients ** 
     154#  elif defined key_traldf_c1d 
     155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_tm , aeiv_tm, aeiw_tm   !: ** 1D coefficients ** 
     156#  else 
     157   REAL(wp), PUBLIC                                        ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 0D coefficients ** 
     158#  endif 
     159#endif 
     160 
     161   ! Temporary physical arrays for sub_stepping 
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp     !: hold current values of avt, un, vn, wn 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  e3t_temp,e3u_temp,e3v_temp,e3w_temp     !: hold current values 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 
     167   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_temp, sshu_b_temp, sshu_a_temp 
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshf_n_temp 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_temp, sshv_b_temp, sshv_a_temp 
     170   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hu_temp, hv_temp, hur_temp, hvr_temp 
     171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp 
     172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp 
     173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_temp, qsr_temp, fr_i_temp,wndm_temp 
     174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, emps_temp, emp_b_temp 
     175   ! 
     176#if defined key_trabbl 
     177   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values  
     178#endif 
     179   ! 
     180#if defined key_ldfslp 
     181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values  
     182#endif 
     183   !  
     184# if defined key_zdfddm 
     185   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 
     186# endif 
     187   ! 
     188#if defined key_traldf_c3d 
     189   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp    
     190#elif defined key_traldf_c2d 
     191   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp   
     192#elif defined key_traldf_c1d 
     193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp  
     194#else 
     195   REAL(wp), PUBLIC                                        ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 
     196#endif 
     197   ! 
     198#if defined key_traldf_eiv 
     199# if defined key_traldf_c3d 
     200   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 3D coefficients ** 
     201# elif defined key_traldf_c2d 
     202   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 2D coefficients ** 
     203# elif defined key_traldf_c1d 
     204   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_temp , aeiv_temp, aeiw_temp   !: ** 1D coefficients ** 
     205# else 
     206   REAL(wp), PUBLIC                                        ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 0D coefficients ** 
     207# endif 
     208# endif 
     209 
    100210   !!---------------------------------------------------------------------- 
    101211   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r2977 r3116  
    9393      !! ** Purpose :   Standard output of passive tracer : concentration fields 
    9494      !! 
    95       !! ** Method  :   At the beginning of the first time step (nit000), define all 
     95      !! ** Method  :   At the beginning of the first time step (nittrc000), define all 
    9696      !!             the NETCDF files and fields for concentration of passive tracer 
    9797      !! 
    … …  
    143143 
    144144      ! define time axis 
    145       itmod = kt - nit000 + 1 
     145      itmod = kt - nittrc000 + 1 
    146146      it    = kt 
    147147      iiter = ( nit000 - 1 ) / nn_dttrc 
    … …  
    152152      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 
    153153       
    154       IF( kt == nit000 ) THEN 
     154      IF( kt == nittrc000 ) THEN 
    155155 
    156156         IF(lwp) THEN                   ! control print 
    … …  
    167167         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    168168         IF(lwp)WRITE(numout,*)' '   
    169          IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         & 
     169         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
    170170            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    171171            &                 ,'Julian day : ', zjulian   
    … …  
    241241      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays 
    242242      !! 
    243       !! ** Method  :   At the beginning of the first time step (nit000), define all 
     243      !! ** Method  :   At the beginning of the first time step (nittrc000), define all 
    244244      !!             the NETCDF files and fields for concentration of passive tracer 
    245245      !! 
    … …  
    290290 
    291291      ! define time axis 
    292       itmod = kt - nit000 + 1 
     292      itmod = kt - nittrc000 + 1 
    293293      it    = kt 
    294294      iiter = ( nit000 - 1 ) / nn_dttrc 
    … …  
    299299      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 
    300300 
    301       IF( kt == nit000 ) THEN 
     301      IF( kt == nittrc000 ) THEN 
    302302 
    303303         ! Define the NETCDF files for additional arrays : 2D or 3D 
    … …  
    382382      !! ** Purpose :   output of passive tracer : biological fields 
    383383      !! 
    384       !! ** Method  :   At the beginning of the first time step (nit000), define all 
     384      !! ** Method  :   At the beginning of the first time step (nittrc000), define all 
    385385      !!             the NETCDF files and fields for concentration of passive tracer 
    386386      !! 
    … …  
    431431 
    432432      ! define time axis 
    433       itmod = kt - nit000 + 1 
     433      itmod = kt - nittrc000 + 1 
    434434      it    = kt 
    435435      iiter = ( nit000 - 1 ) / nn_dttrc 
    … …  
    440440      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
    441441 
    442       IF( kt == nit000 ) THEN 
     442      IF( kt == nittrc000 ) THEN 
    443443 
    444444         ! Define the NETCDF files for biological trends 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r2997 r3116  
    2929   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    3030   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
     31   USE trcsub       ! variables to substep passive tracers 
    3132    
    3233   IMPLICIT NONE 
    … …  
    106107      IF( ln_rsttr ) THEN 
    107108        ! 
    108         IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
     109        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nittrc000 (leap-frog) 
    109110        CALL trc_rst_read              ! restart from a file 
    110111        ! 
    111112      ELSE 
    112113        IF( lk_offline )  THEN 
    113            neuler = 0                  ! Set time-step indicator at nit000 (euler) 
     114           neuler = 0                  ! Set time-step indicator at nittrc000 (euler) 
    114115           CALL day_init               ! set calendar 
    115116        ENDIF 
    … …  
    138139       
    139140      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    140         &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    141  
     141        &    CALL zps_hde( nittrc000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    142142      !                                                              ! masked grid volume 
    143143      DO jk = 1, jpk 
    … …  
    147147      !                                                              ! total volume of the ocean  
    148148      areatot = glob_sum( cvol(:,:,:) ) 
     149 
     150      ! 
     151      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     152      ! 
    149153 
    150154      trai(:) = 0._wp                                                   ! initial content of all tracers 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r2977 r3116  
    105105      END DO 
    106106 
     107      !!KPE  computes the first time step of tracer model 
     108      nittrc000 = nit000 + nn_dttrc - 1 
     109  
    107110 
    108111      IF(lwp) THEN                   ! control print 
    … …  
    112115         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
    113116         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
     117         WRITE(numout,*) '    first time step for pass. trac.             nittrc000     = ', nittrc000 
     118         WRITE(numout,*) '    frequency of outputs for passive tracers    nn_writetrc   = ', nn_writetrc   
    114119         WRITE(numout,*) '   Read inputs data from file                   ln_trcdta     = ', ln_trcdta 
    115120         WRITE(numout,*) ' ' 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r2997 r3116  
    6060      ! 
    6161      IF( lk_offline ) THEN 
    62          IF( kt == nit000 ) THEN 
     62         IF( kt == nittrc000 ) THEN 
    6363            lrst_trc = .FALSE. 
    6464            nitrst = nitend 
    … …  
    7171         ENDIF 
    7272      ELSE 
    73          IF( kt == nit000 ) lrst_trc = .FALSE. 
     73         IF( kt == nittrc000 ) lrst_trc = .FALSE. 
    7474      ENDIF 
    7575 
    … …  
    7777      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    7878      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    79       IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 
     79      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
    8080         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8181         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    … …  
    119119      ! Time domain : restart 
    120120      ! --------------------- 
    121       CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
     121      CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
    122122 
    123123      ! READ prognostic variables and computes diagnostic variable 
    … …  
    151151      REAL(wp) :: zarak0 
    152152      !!---------------------------------------------------------------------- 
    153  
    154153 
    155154      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar 
    … …  
    196195      !! 
    197196      !!   According to namelist parameter nrstdt, 
    198       !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary). 
    199       !!       nn_rsttr = 1  we verify that nit000 is equal to the last 
     197      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary). 
     198      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last 
    200199      !!                   time step of previous run + 1. 
    201200      !!       In both those options, the  exact duration of the experiment 
    … …  
    223222            WRITE(numout,*) ' *** restart option' 
    224223            SELECT CASE ( nn_rsttr ) 
    225             CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 
    226             CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
     224            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
     225            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
    227226            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    228227            END SELECT 
    … …  
    230229         ENDIF 
    231230         ! Control of date  
    232          IF( nit000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
    233             &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
     231         IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     232            &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    234233            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    235234         IF( lk_offline ) THEN      ! set the date in offline mode 
    … …  
    246245            ELSE 
    247246               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    248                adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     247               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
    249248               ! note this is wrong if time step has changed during run 
    250249            ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r3093 r3116  
    2222   USE iom 
    2323   USE in_out_manager 
     24   USE trcsub 
    2425 
    2526   IMPLICIT NONE 
    … …  
    5354      !!------------------------------------------------------------------- 
    5455      ! 
    55       IF( kt == nit000 ) THEN 
     56      IF( kt == nittrc000 ) THEN 
    5657                               CALL iom_close( numrtr )     ! close input  passive tracers restart file 
    5758         IF( lk_trdmld_trc  )  CALL trd_mld_trc_init        ! trends: Mixed-layer 
    … …  
    6667      ENDIF 
    6768      !     
    68       IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
     69     IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
     70 
     71     IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
    6972         ! 
    7073         IF(ln_ctl) THEN 
    … …  
    8386         IF( lrst_trc )            CALL trc_rst_wri( kt )       ! write tracer restart file 
    8487         IF( lk_trdmld_trc  )      CALL trd_mld_trc( kt )       ! trends: Mixed-layer 
     88         ! 
     89         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )  ! resetting physical variables when sub-stepping 
    8590         ! 
    8691      ENDIF 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r2977 r3116  
    5757      !!--------------------------------------------------------------------- 
    5858  
    59       IF( lk_offline .AND. kt == nit000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
     59      IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
    6060         CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
    6161         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/SETTE/sette.sh

    r3029 r3116  
    145145cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit 
    146146 
    147 for config in 1 2 3 4 5 6 7 8 9 10 
     147for config in 1 2 3 4 5 6 7 8 9 
    148148do 
    149149 
    … …  
    543543fi 
    544544 
    545  
    546545if [ ${config} -eq 9 ] ;  then 
    547     ## ORCA2_LIM with Agulhas AGRIF zoom 
    548     export TEST_NAME="SHORT" 
    549     cd ${SETTE_DIR} 
    550     . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2AGUL -r ORCA2_LIM  -j 8 add_key "key_agrif" del_key "key_zdftmx" 
    551     cd ${SETTE_DIR} 
    552     . param.cfg 
    553     . all_functions.sh 
    554     . prepare_exe_dir.sh 
    555     cd ${EXE_DIR} 
    556     set_namelist namelist nn_it000 1 
    557     set_namelist namelist nn_itend 75 
     546    ## Reproductibility tests for AMM12 
     547    cd ${SETTE_DIR} 
     548    . ../CONFIG/makenemo -m ${CMP_NAM} -n AMM12_32 -r AMM12 add_key "key_mpp_mpi key_mpp_rep" 
     549    cd ${SETTE_DIR} 
     550    . param.cfg 
     551    . all_functions.sh 
     552    copy_original namelist 
     553    set_namelist namelist nn_it000 1 
     554    set_namelist namelist nn_itend 576 
     555    set_namelist namelist nn_fwb 0 
    558556    set_namelist namelist ln_ctl .false. 
    559557    set_namelist namelist ln_clobber .true. 
    560     set_namelist 1_namelist nn_it000 1 
    561     set_namelist 1_namelist nn_itend 150 
    562     set_namelist 1_namelist ln_ctl .false. 
    563     set_namelist 1_namelist ln_clobber .true. 
    564     cd ${SETTE_DIR} 
    565     . ./fcm_job.sh input_ORCA2_LIM_AGRIF.cfg 1 ${TEST_NAME} 
    566 fi 
    567  
    568 if [ ${config} -eq 10 ] ;  then 
    569     ## ORCA2_LIM with Agulhas AGRIF zoom in MPI 
    570     export TEST_NAME="SHORT" 
    571     cd ${SETTE_DIR} 
    572     . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2AGUL_1_2 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_mpp_mpi key_agrif" del_key "key_zdftmx" 
    573     cd ${SETTE_DIR} 
    574     . param.cfg 
    575     . all_functions.sh 
    576     . prepare_exe_dir.sh 
    577     cd ${EXE_DIR} 
    578     set_namelist namelist nn_it000 1 
    579     set_namelist namelist nn_itend 75 
     558    set_namelist namelist jpni 8 
     559    set_namelist namelist jpnj 4 
     560    set_namelist namelist jpnij 32 
     561    cd ${SETTE_DIR} 
     562    . ./fcm_job.sh input_AMM12.cfg 32 REPRO_8_4 
     563 
     564    cd ${SETTE_DIR} 
     565    copy_original namelist 
     566    set_namelist namelist nn_it000 1 
     567    set_namelist namelist nn_itend 576 
     568    set_namelist namelist nn_fwb 0 
    580569    set_namelist namelist ln_ctl .false. 
    581570    set_namelist namelist ln_clobber .true. 
    582     set_namelist namelist jpni 1 
    583     set_namelist namelist jpnj 2 
    584     set_namelist namelist jpnij 2 
    585     set_namelist 1_namelist nn_it000 1 
    586     set_namelist 1_namelist nn_itend 150 
    587     set_namelist 1_namelist ln_ctl .false. 
    588     set_namelist 1_namelist ln_clobber .true. 
    589     cd ${SETTE_DIR} 
    590     . ./fcm_job.sh input_ORCA2_LIM_AGRIF.cfg 2 ${TEST_NAME} 
    591 fi 
    592  
    593  
    594  
     571    set_namelist namelist jpni 4 
     572    set_namelist namelist jpnj 8 
     573    set_namelist namelist jpnij 32 
     574    cd ${SETTE_DIR} 
     575    . ./fcm_job.sh input_AMM12.cfg 32 REPRO_4_8 
     576fi 
    595577done 

  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/TOOLS/COMPILE/cfg.txt

    r2977 r3116  
    33GYRE_LOBSTER OPA_SRC TOP_SRC 
    44ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    5 POMME OPA_SRC NST_SRC 
    65ORCA2_LIM3 OPA_SRC LIM_SRC_3 
    76ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    8 ORCA2_LIM_CFC OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    9 ORCA2_OFF_CFC OPA_SRC OFF_SRC TOP_SRC 
     7POMME OPA_SRC NST_SRC 
     8AMM12 OPA_SRC 
     9AMM12-PISCES OPA_SRC TOP_SRC 
Note: See TracChangeset for help on using the changeset viewer.