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

Changeset 5350


Ignore:
Timestamp:
2015-06-04T16:12:19+02:00 (9 years ago)
Author:
hadcv
Message:

Update to head of the trunk (r5344).

Location:
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM
Files:
3 deleted
199 edited
7 copied

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm

    r5094 r5350  
    1818%NCDF_INC            -I/srv/lib/netcdf-x/include 
    1919%NCDF_LIB            -L/srv/lib/netcdf-x/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lstdc++ 
    20 %XIOS_ROOT           /home/delrosso/XIOS_482/XIOS 
     20%XIOS_ROOT           /home/delrosso/XIOS_1.0/xios-1.0 
    2121%MPI_INTEL           -I/srv/intel/impi/4.1.0.024/include 
    2222%CPP                 cpp 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r5109 r5350  
    394394&namptr       !   Poleward Transport Diagnostic 
    395395!----------------------------------------------------------------------- 
    396    ln_diaznl  = .false.    !  Add zonal means and meridional stream functions 
    397    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
    398                            !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    399    ln_ptrcomp = .false.    !  Add decomposition : overturning 
    400 / 
    401 !----------------------------------------------------------------------- 
     396/ 
    402397&namhsb       !  Heat and salt budgets 
    403398!----------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg

    r5102 r5350  
    195195&nameos        !   ocean physical parameters 
    196196!----------------------------------------------------------------------- 
    197    nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency 
     197   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency 
    198198/ 
    199199!----------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0

    r4394 r5350  
    114114export VAR1_Ithick  V1It_PREF    V1It_SUFF 
    115115export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF 
    116 export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF 
     116export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF 
    117117#===================== EXP2 ===================== 
    118118export DATE1_2      DATE2_2 
    … …  
    127127export VAR2_Ithick  V2It_PREF    V2It_SUFF 
    128128export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF 
    129 export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF 
     129export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF 
    130130# 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2

    r4394 r5350  
    114114export VAR1_Ithick  V1It_PREF    V1It_SUFF 
    115115export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF 
    116 export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF 
     116export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF 
    117117#===================== EXP2 ===================== 
    118118export DATE1_2      DATE2_2 
    … …  
    127127export VAR2_Ithick  V2It_PREF    V2It_SUFF 
    128128export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF 
    129 export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF 
     129export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF 
    130130# 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1

    r4394 r5350  
    112112export VAR1_Ithick  V1It_PREF    V1It_SUFF 
    113113export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF 
    114 export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF 
     114export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF 
    115115#===================== EXP2 ===================== 
    116116export DATE1_2      DATE2_2 
    … …  
    125125export VAR2_Ithick  V2It_PREF   V2It_SUFF 
    126126export VAR2_SNOW    V2SNOW_PREF V2SNOW_SUFF 
    127 export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF 
     127export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF 
    128128# 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2

    r4394 r5350  
    112112export VAR1_Ithick  V1It_PREF    V1It_SUFF 
    113113export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF 
    114 export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF 
     114export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF 
    115115#===================== EXP2 ===================== 
    116116export DATE1_2      DATE2_2 
    … …  
    125125export VAR2_Ithick  V2It_PREF   V2It_SUFF 
    126126export VAR2_SNOW    V2SNOW_PREF V2SNOW_SUFF 
    127 export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF 
     127export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF 
    128128# 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/domain_def.xml

    r4690 r5350  
    66         <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" /> 
    77         <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" /> 
     8         <domain id="ptr" zoom_ibegin="0000"  zoom_jbegin="1" zoom_ni="1" zoom_nj="0000" /> 
    89         <!--   Eq section   --> 
    910         <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" /> 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5342 r5350  
    562562        <field id="berg_real_calving"  long_name="icb calving into iceberg class"                  unit="kg/s"     axis_ref="icbcla" /> 
    563563        <field id="berg_stored_ice"    long_name="icb accumulated ice mass by class"               unit="kg"       axis_ref="icbcla" /> 
     564      </field_group> 
     565 
     566      <!-- Poleward transport : ptr -->      
     567      <field_group id="diaptr" domain_ref="ptr"  >  
     568        <field id="zomsfglo"          long_name="Meridional Stream-Function: Global"           unit="Sv"       grid_ref="grid_W_3D"  /> 
     569        <field id="zomsfatl"          long_name="Meridional Stream-Function: Atlantic"         unit="Sv"       grid_ref="grid_W_3D"  /> 
     570        <field id="zomsfpac"          long_name="Meridional Stream-Function: Pacific"          unit="Sv"       grid_ref="grid_W_3D"  /> 
     571        <field id="zomsfind"          long_name="Meridional Stream-Function: Indian"           unit="Sv"       grid_ref="grid_W_3D"  /> 
     572        <field id="zomsfipc"          long_name="Meridional Stream-Function: Pacific+Indian"   unit="Sv"       grid_ref="grid_W_3D"  /> 
     573        <field id="zotemglo"          long_name="Zonal Mean Temperature : Global"              unit="degC"     grid_ref="grid_T_3D"  /> 
     574        <field id="zotematl"          long_name="Zonal Mean Temperature : Atlantic"            unit="degC"     grid_ref="grid_T_3D"  /> 
     575        <field id="zotempac"          long_name="Zonal Mean Temperature : Pacific"             unit="degC"     grid_ref="grid_T_3D"  /> 
     576        <field id="zotemind"          long_name="Zonal Mean Temperature : Indian"              unit="degC"     grid_ref="grid_T_3D"  /> 
     577        <field id="zotemipc"          long_name="Zonal Mean Temperature : Pacific+Indian"      unit="degC"     grid_ref="grid_T_3D"  /> 
     578        <field id="zosalglo"          long_name="Zonal Mean Salinity : Global"                 unit="1e-3"     grid_ref="grid_T_3D"  /> 
     579        <field id="zosalatl"          long_name="Zonal Mean Salinity : Atlantic"               unit="1e-3"     grid_ref="grid_T_3D"  /> 
     580        <field id="zosalpac"          long_name="Zonal Mean Salinity : Pacific"                unit="1e-3"     grid_ref="grid_T_3D"  /> 
     581        <field id="zosalind"          long_name="Zonal Mean Salinity : Indian"                 unit="1e-3"     grid_ref="grid_T_3D"  /> 
     582        <field id="zosalipc"          long_name="Zonal Mean Salinity : Pacific+Indian"         unit="1e-3"     grid_ref="grid_T_3D"  /> 
     583        <field id="zosrfglo"          long_name="Zonal Mean Surface"                           unit="m2"       grid_ref="grid_T_3D"  /> 
     584        <field id="zosrfatl"          long_name="Zonal Mean Surface : Atlantic"                unit="m2"       grid_ref="grid_T_3D"  /> 
     585        <field id="zosrfpac"          long_name="Zonal Mean Surface : Pacific"                 unit="m2"       grid_ref="grid_T_3D"  /> 
     586        <field id="zosrfind"          long_name="Zonal Mean Surface : Indian"                  unit="m2"       grid_ref="grid_T_3D"  /> 
     587        <field id="zosrfipc"          long_name="Zonal Mean Surface : Pacific+Indian"          unit="m2"       grid_ref="grid_T_3D"  /> 
     588        <field id="sophtadv"          long_name="Advective Heat Transport"                     unit="PW"       grid_ref="grid_T_2D"  /> 
     589        <field id="sophtldf"          long_name="Diffusive Heat Transport"                     unit="PW"       grid_ref="grid_T_2D"  /> 
     590        <field id="sopstadv"          long_name="Advective Salt Transport"                     unit="Giga g/s" grid_ref="grid_T_2D"  /> 
     591        <field id="sopstldf"          long_name="Diffusive Salt Transport"                     unit="Giga g/s" grid_ref="grid_T_2D"  /> 
    564592      </field_group> 
    565593 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref

    r5124 r5350  
    1414!----------------------------------------------------------------------- 
    1515   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input) 
     16   cn_icerst_indir = "."              !  directory from which to read input ice restarts 
    1617   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output) 
     18   cn_icerst_outdir = "."             !  directory in which to write output ice restarts 
    1719   ln_limdyn     = .true.             !  ice dynamics (T) or thermodynamics only (F) 
    1820   ln_limdmp     = .false.            !  restoring ice thickness and fraction leads   (T => fill  namice_dmp) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r5129 r5350  
    1717   nlay_s         =    1           !  number of snow layers (only 1 is working) 
    1818   cn_icerst_in  = "restart_ice"   !  suffix of ice restart name (input) 
     19   cn_icerst_indir = "."           !  directory from which to read input ice restarts 
    1920   cn_icerst_out = "restart_ice"   !  suffix of ice restart name (output) 
     21   cn_icerst_outdir = "."          !  directory in which to write output ice restarts 
    2022   ln_limdyn     = .true.          !  ice dynamics (T) or thermodynamics only (F) 
    2123   rn_amax       = 0.999           !  maximum tolerated ice concentration  
    … …  
    4547&namiceitd     !   Ice discretization 
    4648!------------------------------------------------------------------------------ 
    47    nn_catbnd      =    1           !  computation of ice category boundaries based on 
     49   nn_catbnd      =    2           !  computation of ice category boundaries based on 
    4850                                   !      1: tanh function 
    4951                                   !      2: h^(-alpha), function of rn_himean 
    50    rn_himean      =    2.5         !  expected domain-average ice thickness (m), nn_catbnd = 2 only 
     52   rn_himean      =    2.0         !  expected domain-average ice thickness (m), nn_catbnd = 2 only 
    5153/ 
    5254!------------------------------------------------------------------------------ 
    … …  
    9496                                   !     3: activate G(he) only              --- temporary option 
    9597                                   !     4: activate lateral melting only    --- temporary option 
     98  ln_it_qnsice = .true.            !  iterate the surface non-solar flux with surface temperature (T) or not (F) 
    9699/ 
    97100!------------------------------------------------------------------------------ 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref

    r4529 r5350  
    4848!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    4949   concnno3   =  1.e-6    ! Nitrate half saturation of nanophytoplankton 
    50    concdno3   =  3.E-6    ! Phosphate half saturation for diatoms 
     50   concdno3   =  3.E-6    ! Nitrate half saturation for diatoms 
    5151   concnnh4   =  1.E-7    ! NH4 half saturation for phyto 
    5252   concdnh4   =  3.E-7    ! NH4 half saturation for diatoms 
    5353   concnfer   =  1.E-9    ! Iron half saturation for phyto 
    5454   concdfer   =  3.E-9    ! Iron half saturation for diatoms 
    55    concbfe    =  1.E-11   ! Half-saturation for Fe limitation of Bacteria 
    56    concbnh4   =  2.E-8    ! NH4 half saturation for phyto 
    57    concbno3   =  2.E-7    ! Phosphate half saturation for diatoms 
     55   concbfe    =  1.E-11   ! Iron half-saturation for DOC remin. 
     56   concbnh4   =  2.E-8    ! NH4 half saturation for DOC remin. 
     57   concbno3   =  2.E-7    ! Nitrate half saturation for DOC remin. 
    5858   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms 
    5959   xsizephy   =  1.E-6    ! Minimum size criteria for phyto 
    … …  
    6161   xsizerd    =  3.0      ! Size ratio for diatoms 
    6262   xksi1      =  2.E-6    ! half saturation constant for Si uptake 
    63    xksi2      =  20E-6  ! half saturation constant for Si/C 
     63   xksi2      =  20E-6    ! half saturation constant for Si/C 
    6464   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization 
    6565   qnfelim    =  7.E-6    ! Optimal quota of phyto 
    … …  
    8686   excret2    =  0.05     ! excretion ratio of diatoms 
    8787   ln_newprod =  .true.   ! Enable new parame. of production (T/F)  
    88    bresp      =  0.00333  ! Basal respiration rate 
    89    chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton 
    90    chlcdm     =  0.05     ! Minimum Chl/C in diatoms 
    91    chlcmin    =  0.004    ! Maximum Chl/c in phytoplankton 
     88   bresp      =  0.033    ! Basal respiration rate 
     89   chlcnm     =  0.033    ! Maximum Chl/C in nanophytoplankton 
     90   chlcdm     =  0.05     ! Maximum Chl/C in diatoms 
     91   chlcmin    =  0.004    ! Minimum Chl/c in phytoplankton 
    9292   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton 
    93    fecdm      =  40E-6    ! Minimum Fe/C in diatoms 
     93   fecdm      =  40E-6    ! Maximum Fe/C in diatoms 
    9494   grosip     =  0.159    ! mean Si/C ratio 
    9595/ 
    … …  
    110110   resrat2    =  0.005    ! exsudation rate of mesozooplankton 
    111111   mzrat2     =  0.03     ! mesozooplankton mortality rate 
    112    xprefc     =  1.       ! zoo preference for phyto 
    113    xprefp     =  0.3      ! zoo preference for POC 
    114    xprefz     =  1.       ! zoo preference for zoo 
    115    xprefpoc   =  0.3      ! zoo preference for poc 
     112   xprefc     =  1.       ! mesozoo preference for diatoms 
     113   xprefp     =  0.3      ! mesozoo preference for nanophyto. 
     114   xprefz     =  1.       ! mesozoo preference for microzoo. 
     115   xprefpoc   =  0.3      ! mesozoo preference for poc 
    116116   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton  
    117117   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton  
    … …  
    119119   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton  
    120120   xthresh2   =  3E-7     ! Food threshold for grazing 
    121    xkgraz2    =  20.E-6   ! half sturation constant for meso grazing 
     121   xkgraz2    =  20.E-6   ! half saturation constant for meso grazing 
    122122   epsher2    =  0.35     ! Efficicency of Mesozoo growth 
    123123   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM 
    … …  
    156156&nampisrem     !   parameters for remineralization 
    157157!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    158    xremik    =  0.35      ! remineralization rate of DOC 
     158   xremik    =  0.3       ! remineralization rate of DOC 
    159159   xremip    =  0.025     ! remineralisation rate of POC 
    160160   nitrif    =  0.05      ! NH4 nitrification rate 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5342 r5350  
    1010!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 
    1111!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) 
    12 !!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb) 
     12!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto) 
    1313!!             10 - miscellaneous    (namsol, nammpp, namctl) 
    1414!!             11 - Obs & Assim      (namobs, nam_asminc) 
    … …  
    3737                           !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart 
    3838   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input) 
     39   cn_ocerst_indir = "."       !  directory from which to read input ocean restarts 
    3940   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output) 
     41   cn_ocerst_outdir = "."      !  directory in which to write output ocean restarts 
    4042   nn_istate   =       0   !  output the initial state (1) or not (0) 
     43   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 
    4144   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1) 
     45   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written 
    4246   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000) 
    4347   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T) 
    … …  
    5155!!                      ***  Domain namelists  *** 
    5256!!====================================================================== 
    53 !!   namcfg       parameters of the configuration       
     57!!   namcfg       parameters of the configuration 
    5458!!   namzgr       vertical coordinate 
    5559!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    … …  
    5963! 
    6064!----------------------------------------------------------------------- 
    61 &namcfg     !   parameters of the configuration       
     65&namcfg     !   parameters of the configuration 
    6266!----------------------------------------------------------------------- 
    6367   cp_cfg      =  "default"            !  name of the configuration 
    … …  
    7377   jperio      =       0               !  lateral cond. type (between 0 and 6) 
    7478                                       !  = 0 closed                 ;   = 1 cyclic East-West 
    75                                        !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot  
     79                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot 
    7680                                       !  = 4 cyclic East-West AND North fold T-point pivot 
    7781                                       !  = 5 North fold F-point pivot 
    7882                                       !  = 6 cyclic East-West AND North fold F-point pivot 
    79    ln_use_jattr = .false.              !  use (T) the file attribute: open_ocean_jstart, if present  
     83   ln_use_jattr = .false.              !  use (T) the file attribute: open_ocean_jstart, if present 
    8084                                       !  in netcdf input files, as the start j-row for reading 
    8185/ 
    … …  
    102106                        !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.) 
    103107   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20) 
    104    rn_bb       =    0.8    !  stretching with SH94 s-sigma    
     108   rn_bb       =    0.8    !  stretching with SH94 s-sigma 
    105109                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.) 
    106110   rn_alpha    =    4.4    !  stretching with SF12 s-sigma 
    … …  
    111115   rn_zb_b     =   -0.2    !  offset for calculating Zb 
    112116                        !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above] 
    113    rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1)  
     117   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1) 
    114118/ 
    115119!----------------------------------------------------------------------- 
    … …  
    119123   rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1 
    120124   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
    121    nn_msh      =    0      !  create (=1) a mesh file or not (=0) 
     125   nn_msh      =    1      !  create (=1) a mesh file or not (=0) 
    122126   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0) 
    123127   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of 
    … …  
    165169   nn_baro       =    30               !  Number of iterations of barotropic mode 
    166170                                       !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F 
    167    rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T  
     171   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T 
    168172   nn_bt_flt     =    1                !  Time filter choice 
    169173                                       !  = 0 None 
    170174                                       !  = 1 Boxcar over   nn_baro barotropic steps 
    171                                        !  = 2 Boxcar over 2*nn_baro     "        "   
     175                                       !  = 2 Boxcar over 2*nn_baro     "        " 
    172176/ 
    173177!----------------------------------------------------------------------- 
    … …  
    246250   ln_rnf      = .true.    !  runoffs                                   (T   => fill namsbc_rnf) 
    247251   nn_isf      = 0         !  ice shelf melting/freezing                (/=0 => fill namsbc_isf) 
    248                            !  0 =no isf                  1 = presence of ISF  
    249                            !  2 = bg03 parametrisation   3 = rnf file for isf    
     252                           !  0 =no isf                  1 = presence of ISF 
     253                           !  2 = bg03 parametrisation   3 = rnf file for isf 
    250254                           !  4 = ISF fwf specified 
    251255                           !  option 1 and 4 need ln_isfcav = .true. (domzgr) 
    … …  
    278282&namsbc_flx    !   surface boundary condition : flux formulation 
    279283!----------------------------------------------------------------------- 
    280 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !  
     284!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    281285!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    282286   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''       , '' 
    … …  
    321325   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    322326   rn_zqt      = 10.        !  Air temperature and humidity reference height (m) 
    323    rn_zu       = 10.        !  Wind vector reference height (m)                  
     327   rn_zu       = 10.        !  Wind vector reference height (m) 
    324328   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    325329   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    326    rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity  
     330   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
    327331                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
    328332/ 
    … …  
    374378!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    375379!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    376    sn_usp      = 'sas_grid_U' ,    120           , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''       
     380   sn_usp      = 'sas_grid_U' ,    120           , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
    377381   sn_vsp      = 'sas_grid_V' ,    120           , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
    378382   sn_tem      = 'sas_grid_T' ,    120           , 'sosstsst' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , '' 
    … …  
    423427/ 
    424428!----------------------------------------------------------------------- 
    425 &namsbc_isf    !  Top boundary layer (ISF)  
     429&namsbc_isf    !  Top boundary layer (ISF) 
    426430!----------------------------------------------------------------------- 
    427431!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! 
    … …  
    500504                                                      ! Initial mass required for an iceberg of each class 
    501505      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11 
    502                                                       ! Proportion of calving mass to apportion to each class   
     506                                                      ! Proportion of calving mass to apportion to each class 
    503507      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02 
    504508                                                      ! Ratio between effective and real iceberg mass (non-dim) 
    505                                                       ! i.e. number of icebergs represented at a point          
     509                                                      ! i.e. number of icebergs represented at a point 
    506510      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1 
    507511                                                      ! thickness of newly calved bergs (m) 
    … …  
    512516      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits 
    513517      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1) 
    514       ln_passive_mode          = .false.              ! iceberg - ocean decoupling    
     518      ln_passive_mode          = .false.              ! iceberg - ocean decoupling 
    515519      nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no) 
    516520                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2) 
    517521      rn_test_box              = 108.0,  116.0, -66.0, -58.0 
    518       rn_speed_limit           = 0.                   ! CFL speed limit for a berg    
     522      rn_speed_limit           = 0.                   ! CFL speed limit for a berg 
    519523 
    520524!              ! file name ! frequency (hours) !   variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    521525!              !           !  (if <0  months)  !     name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
    522526      sn_icb =  'calving' ,       -1           , 'calvingmask',  .true.        , .true.  , 'yearly'  , ''       , ''       , '' 
    523     
    524       cn_dir = './'  
     527 
     528      cn_dir = './' 
    525529/ 
    526530 
    … …  
    583587   ln_tide_ramp  = .false.  ! 
    584588   rdttideramp   =    0.    ! 
    585    clname(1)     =   'M2'   !  name of constituent 
    586    clname(2)     =   'S2' 
    587    clname(3)     =   'N2' 
    588    clname(4)     =   'K1' 
    589    clname(5)     =   'O1' 
    590    clname(6)     =   'Q1' 
    591    clname(7)     =   'M4' 
    592    clname(8)     =   'K2' 
    593    clname(9)     =   'P1' 
    594    clname(10)    =   'Mf' 
    595    clname(11)    =   'Mm' 
     589   clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg 
    596590/ 
    597591!----------------------------------------------------------------------- 
    … …  
    608602                                          !  = 2, use tidal harmonic forcing data from files 
    609603                                          !  = 3, use external data AND tidal harmonic forcing 
    610     cn_dyn3d      =  'none'               !   
     604    cn_dyn3d      =  'none'               ! 
    611605    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    612606                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    613     cn_tra        =  'none'               !  
     607    cn_tra        =  'none'               ! 
    614608    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state 
    615609                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    616     cn_ice_lim      =  'none'             !   
     610    cn_ice_lim      =  'none'             ! 
    617611    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state 
    618612                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    … …  
    623617    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers 
    624618    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities 
    625     rn_time_dmp   =  1.                   ! Damping time scale in days  
     619    rn_time_dmp   =  1.                   ! Damping time scale in days 
    626620    rn_time_dmp_out =  1.                 ! Outflow damping time scale 
    627621    nn_rimwidth   = 10                    !  width of the relaxation zone 
    … …  
    676670   rn_bfri2_max =   1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T) 
    677671   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2) 
    678    rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T  
     672   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T 
    679673   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    680674   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
    … …  
    722716!----------------------------------------------------------------------- 
    723717   nn_eos      =  -1     !  type of equation of state and Brunt-Vaisala frequency 
    724                                  !  =-1, TEOS-10  
    725                                  !  = 0, EOS-80  
     718                                 !  =-1, TEOS-10 
     719                                 !  = 0, EOS-80 
    726720                                 !  = 1, S-EOS   (simplified eos) 
    727721   ln_useCT    = .true.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
    … …  
    814808!----------------------------------------------------------------------- 
    815809   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
     810   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    816811   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    817812   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    … …  
    821816&nam_vvl    !   vertical coordinate options 
    822817!----------------------------------------------------------------------- 
    823    ln_vvl_zstar  = .true.           !  zstar vertical coordinate                    
     818   ln_vvl_zstar  = .true.           !  zstar vertical coordinate 
    824819   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations 
    825820   ln_vvl_layer  = .false.          !  full layer vertical coordinate 
    … …  
    10061001!!   namc1d_uvd        data: U & V currents                             ("key_c1d") 
    10071002!!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d") 
     1003!!   namsto            Stochastic parametrization of EOS 
    10081004!!====================================================================== 
    10091005! 
    … …  
    10641060   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
    10651061/ 
     1062!----------------------------------------------------------------------- 
     1063&namsto       ! Stochastic parametrization of EOS 
     1064!----------------------------------------------------------------------- 
     1065   ln_rststo = .false.           ! start from mean parameter (F) or from restart file (T) 
     1066   ln_rstseed = .true.           ! read seed of RNG from restart file 
     1067   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input) 
     1068   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output) 
     1069 
     1070   ln_sto_eos = .false.          ! stochastic equation of state 
     1071   nn_sto_eos = 1                ! number of independent random walks 
     1072   rn_eos_stdxy = 1.4            ! random walk horz. standard deviation (in grid points) 
     1073   rn_eos_stdz  = 0.7            ! random walk vert. standard deviation (in grid points) 
     1074   rn_eos_tcor  = 1440.0         ! random walk time correlation (in timesteps) 
     1075   nn_eos_ord  = 1               ! order of autoregressive processes 
     1076   nn_eos_flt  = 0               ! passes of Laplacian filter 
     1077   rn_eos_lim  = 2.0             ! limitation factor (default = 3.0) 
     1078/ 
    10661079 
    10671080!!====================================================================== 
    … …  
    10701083!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    10711084!!   namtrd       dynamics and/or tracer trends 
     1085!!   namptr       Poleward Transport Diagnostics 
    10721086!!   namflo       float parameters                                      ("key_float") 
    1073 !!   namptr       Poleward Transport Diagnostics 
    10741087!!   namhsb       Heat and salt budgets 
    10751088!!====================================================================== 
    … …  
    11251138!----------------------------------------------------------------------- 
    11261139   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    1127    ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    1128    ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
    1129                            !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    1130    ln_ptrcomp = .true.     !  Add decomposition : overturning 
    1131    nn_fptr    =  1         !  Frequency of ptr computation [time step] 
    1132    nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
     1140   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not 
    11331141/ 
    11341142!----------------------------------------------------------------------- 
    … …  
    11801188   ln_sst     = .false.     ! Logical switch for SST observations 
    11811189   ln_reysst  = .false.     !     ln_reysst               Logical switch for Reynolds observations 
    1182    ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations       
     1190   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations 
    11831191 
    11841192   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
    … …  
    12071215   sstfbfiles = 'sst_01.nc' 
    12081216                           !     seaicefiles             Sea Ice input observation file names 
    1209    seaicefiles = 'seaice_01.nc'   
     1217   seaicefiles = 'seaice_01.nc' 
    12101218                           !     velavcurfiles           Vel. cur. daily av. input file name 
    12111219                           !     velhvcurfiles           Vel. cur. high freq. input file name 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_top_ref

    r5102 r5350  
    2121                           !                  = 2 calendar parameters read in the restart file 
    2222   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
     23   cn_trcrst_indir = "."           !  directory from which to read input passive tracer restarts 
    2324   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     25   cn_trcrst_outdir = "."          !  directory to which to write output passive tracer restarts 
    2426/ 
    2527!----------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/cfg.txt

    r5102 r5350  
    88ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    99ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    10 ISOMIP OPA_SRC 
    1110GYRE OPA_SRC 
    1211ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/makenemo

    r5092 r5350  
    200200       ;; 
    201201   add_key) 
    202        # Checking void argument 
    203        [ ! -z $2 ] && { list_add_key=$2; export ${list_add_key}; } 
     202            # Checking if argument has anything other than whitespace 
     203            [[ ! "$2" =~ ^\ +$ ]] && { list_add_key=$2; export ${list_add_key}; } 
    204204       shift 
    205205       ;; 
    206206   del_key) 
    207        # Checking void argument 
    208        [ ! -z $2 ] && { list_del_key=$2; export ${list_del_key}; } 
     207            # Checking if argument has anything other than whitespace 
     208            [[ ! "$2" =~ ^\ +$ ]] && { list_del_key=$2; export ${list_del_key}; } 
    209209       shift 
    210210       ;; 
    … …  
    317317 
    318318#- At this stage new configuration has been added, we add or remove keys 
    319 [ ! -z ${list_add_key} ] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; } 
    320 [ ! -z ${list_del_key} ] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; } 
     319[ ! -z "${list_add_key}" ] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; } 
     320[ ! -z "${list_del_key}" ] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; } 
    321321 
    322322#- check that all keys are really existing... 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/uspcfg.txt

    r4990 r5350  
    11ORCA1_CICE # ORCA2_LIM # OPA_SRC TOP_SRC  # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ORCA1_CICE/v3.6.0/ORCA1_CICE_ctl.txt 
     2ISOMIP     # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/v3.6.0/ISOMIP_ctl.txt 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r5123 r5350  
    2424   !                                                   !!* namicerun read in iceini  * 
    2525   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in     !: suffix of ice restart name (input) 
     26   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_indir  !: ice restart in directory 
    2627   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out    !: suffix of ice restart name (output) 
     28   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_outdir !: ice restart out directory 
    2729   LOGICAL               , PUBLIC ::   ln_limdyn        !: flag for ice dynamics (T) or not (F) 
    2830   LOGICAL               , PUBLIC ::   ln_limdmp        !: Ice damping 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r4624 r5350  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
    42    !! $Id$  
     42   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
    … …  
    123123      !! ** input   :   Namelist namicerun 
    124124      !!------------------------------------------------------------------- 
    125       NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif 
     125      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 
     126                          ln_limdyn, ln_limdmp, acrit, hsndif, hicdif 
    126127      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    127128      !!------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90

    • Property svn:keywords set to Id

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90

    r2528 r5350  
    5050      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    5151      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     52      CHARACTER(len=150)  ::   clpath   ! full path to ice output restart file 
    5253      !!---------------------------------------------------------------------- 
    5354      ! 
    … …  
    5859      ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 
    5960      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    60          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    61          IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    62          ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     61         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
     62            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     63            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     64            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     65            ENDIF 
     66            ! create the file 
     67            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
     68            clpath = TRIM(cn_icerst_outdir)  
     69            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'  
     70            IF(lwp) THEN 
     71               WRITE(numout,*) 
     72               SELECT CASE ( jprstlib ) 
     73               CASE ( jprstdimg ) 
     74                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname 
     75               CASE DEFAULT 
     76                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname 
     77               END SELECT 
     78               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     79                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     80               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
     81               ENDIF 
     82            ENDIF 
     83 
     84            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     85            lrst_ice = .TRUE. 
    6386         ENDIF 
    64          ! create the file 
    65          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
    66          IF(lwp) THEN 
    67             WRITE(numout,*) 
    68             SELECT CASE ( jprstlib ) 
    69             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname 
    70             CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    71             END SELECT 
    72             IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
    73                WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
    74             ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    75             ENDIF 
    76          ENDIF 
    77  
    78          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
    79          lrst_ice = .TRUE. 
    8087      ENDIF 
    8188      ! 
    … …  
    188195        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    189196        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    190         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     197        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    191198        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    192199      ENDIF 
    193200 
    194       CALL iom_open ( cn_icerst_in, numrir, kiolib = jlibalt ) 
     201      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt ) 
    195202 
    196203      CALL iom_get( numrir, 'kt_ice' , ziter ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r5128 r5350  
    198198   INTEGER , PUBLIC ::   nn_ice_thcon        !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
    199199   INTEGER , PUBLIC ::   nn_monocat          !: virtual ITD mono-category parameterizations (1) or not (0) 
     200   LOGICAL , PUBLIC ::   ln_it_qnsice        !: iterate surface flux with changing surface temperature or not (F) 
    200201 
    201202   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    … …  
    285286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
    286287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux 
    287289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
    288290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
    … …  
    371373   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers  
    372374   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     375   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
    373376   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     377   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
    374378   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    375379   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F) 
    … …  
    392396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content 
    393397   ! 
    394    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   []  
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s]  
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s]  
    395402   ! 
    396403   !!---------------------------------------------------------------------- 
    … …  
    433440         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        & 
    434441         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
    435          &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 
     442         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
     443         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   & 
    436444         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           & 
    437445         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    & 
    … …  
    452460      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
    453461      ii = ii + 1 
    454       ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 
     462      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 
    455463 
    456464      ! * Moments for advection 
    … …  
    468476         &      STAT=ierr(ii) ) 
    469477      ii = ii + 1 
    470       ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     & 
    471          &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) ) 
     478      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     & 
     479         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) ) 
    472480 
    473481      ! * Old values of global variables 
    474482      ii = ii + 1 
    475483      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
    476          &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,  & 
    477          &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)             , STAT=ierr(ii) ) 
     484         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     & 
     485         &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)          , STAT=ierr(ii) ) 
    478486       
    479487      ! * Ice thickness distribution variables 
    … …  
    483491      ! * Ice diagnostics 
    484492      ii = ii + 1 
    485       ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei  (jpi,jpj),   &  
    486          &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) ) 
     493      ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
     494         &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat  (jpi,jpj),   & 
     495         &      diag_smvi  (jpi,jpj), diag_vice   (jpi,jpj), diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
    487496 
    488497      ice_alloc = MAXVAL( ierr(:) ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r5123 r5350  
    88   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations 
    99   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm 
     10   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_lim3 
    … …  
    2223   USE lib_mpp        ! MPP library 
    2324   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     25   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields 
    2426 
    2527   IMPLICIT NONE 
    … …  
    3032   PUBLIC   lim_cons_check 
    3133   PUBLIC   lim_cons_hsm 
     34   PUBLIC   lim_cons_final 
    3235 
    3336   !!---------------------------------------------------------------------- 
    … …  
    7275      !! ** Method  : Arithmetics 
    7376      !!--------------------------------------------------------------------- 
    74       INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories 
    75       INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers 
    76       REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field 
    77       REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field 
     77      INTEGER                                , INTENT(in   ) ::   ksum   !: number of categories 
     78      INTEGER                                , INTENT(in   ) ::   klay   !: number of vertical layers 
     79      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in   ) ::   pin    !: input field 
     80      REAL(wp), DIMENSION(jpi,jpj)           , INTENT(  out) ::   pout   !: output field 
    7881      ! 
    7982      INTEGER ::   jk, jl   ! dummy loop indices 
    … …  
    155158 
    156159   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
    157       !!------------------------------------------------------------------- 
    158       !!               ***  ROUTINE lim_cons_hsm *** 
    159       !! 
    160       !! ** Purpose : Test the conservation of heat, salt and mass for each routine 
    161       !! 
    162       !! ** Method  : 
    163       !!--------------------------------------------------------------------- 
    164       INTEGER         , INTENT(in)    :: icount      ! determine wether this is the beggining of the routine (0) or the end (1) 
    165       CHARACTER(len=*), INTENT(in)    :: cd_routine  ! name of the routine 
     160      !!-------------------------------------------------------------------------------------------------------- 
     161      !!                                        ***  ROUTINE lim_cons_hsm *** 
     162      !! 
     163      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 
     164      !!                     + test if ice concentration and volume are > 0 
     165      !! 
     166      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     167      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
     168      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to 
     169      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
     170      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
     171      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
     172      !!-------------------------------------------------------------------------------------------------------- 
     173      INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1) 
     174      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
    166175      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    167176      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
    168177      REAL(wp)                        :: zvmin, zamin, zamax  
    169       REAL(wp)                        :: zconv 
    170  
    171       zconv = 1.e-9 
     178      REAL(wp)                        :: zvtrp, zetrp 
     179      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill 
     180      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
    172181 
    173182      IF( icount == 0 ) THEN 
    174183 
     184         ! salt flux 
    175185         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    176186            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
    177             &                ) *  e12t(:,:) * tmask(:,:,1) ) 
    178  
     187            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     188 
     189         ! water flux 
    179190         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    180191            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
    181             &                ) *  e12t(:,:) * tmask(:,:,1) ) 
    182  
     192            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     193 
     194         ! heat flux 
    183195         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    184196            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    185197            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
    186198 
    187          zvi_b  = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * e12t(:,:) * tmask(:,:,1) ) 
    188  
    189          zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) 
     199         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv ) 
     200 
     201         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e12t * tmask(:,:,1) * zconv ) 
    190202 
    191203         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
    192204            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
    193                             ) * e12t(:,:) * tmask(:,:,1) * zconv ) 
     205                            ) * e12t * tmask(:,:,1) * zconv ) 
    194206 
    195207      ELSEIF( icount == 1 ) THEN 
    196208 
     209         ! salt flux 
    197210         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    198211            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
    199             &              ) * e12t(:,:) * tmask(:,:,1) ) - zfs_b 
    200  
     212            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
     213 
     214         ! water flux 
    201215         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    202216            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
    203             &              ) * e12t(:,:) * tmask(:,:,1) ) - zfw_b 
    204  
     217            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
     218 
     219         ! heat flux 
    205220         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    206221            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    207222            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b 
    208223  
    209          zvi  = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 )  & 
    210             &                    * e12t(:,:) * tmask(:,:,1) ) - zvi_b ) * r1_rdtice - zfw  
    211  
    212          zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) - zsmv_b ) * r1_rdtice + ( zfs * r1_rhoic ) 
     224         ! outputs 
     225         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  & 
     226            &                    * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 
     227 
     228         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  & 
     229            &                    * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 
    213230 
    214231         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
    215232            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
    216             &                ) * e12t(:,:) * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 
     233            &                ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 
     234 
     235         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 
     236         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday  
     237         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e12t * tmask(:,:,1) * zconv ) 
    217238 
    218239         zvmin = glob_min( v_i ) 
    219240         zamax = glob_max( SUM( a_i, dim=3 ) ) 
    220241         zamin = glob_min( a_i ) 
    221         
     242 
     243         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     244         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 
     245         zv_sill = zarea * 2.5e-5 
     246         zs_sill = zarea * 25.e-5 
     247         zh_sill = zarea * 10.e-5 
     248 
    222249         IF(lwp) THEN 
    223             IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday) 
    224             IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 
    225             IF ( ABS( zei    ) >  1.e-4 ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',(zei) 
    226             IF ( zvmin <  -epsi10       ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
    227             IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > rn_amax+epsi10 ) THEN 
    228                                           WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     250            IF ( ABS( zvi  ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zvi 
     251            IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv 
     252            IF ( ABS( zei  ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zei 
     253            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN 
     254                                         WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp 
     255                                         WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp 
    229256            ENDIF 
    230             IF ( zamin <  -epsi10       ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     257            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin 
     258            IF (     zamax   > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
     259                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     260            ENDIF 
     261            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    231262         ENDIF 
    232263 
    … …  
    234265 
    235266   END SUBROUTINE lim_cons_hsm 
     267 
     268   SUBROUTINE lim_cons_final( cd_routine ) 
     269      !!--------------------------------------------------------------------------------------------------------- 
     270      !!                                   ***  ROUTINE lim_cons_final *** 
     271      !! 
     272      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 
     273      !! 
     274      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     275      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
     276      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to 
     277      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
     278      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
     279      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
     280      !!-------------------------------------------------------------------------------------------------------- 
     281      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
     282      REAL(wp)                        :: zhfx, zsfx, zvfx 
     283      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill 
     284      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
     285 
     286#if ! defined key_bdy 
     287      ! heat flux 
     288      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv )  
     289      ! salt flux 
     290      zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday 
     291      ! water flux 
     292      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday 
     293 
     294      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     295      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 
     296      zv_sill = zarea * 2.5e-5 
     297      zs_sill = zarea * 25.e-5 
     298      zh_sill = zarea * 10.e-5 
     299 
     300      IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx) 
     301      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx) 
     302      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx) 
     303#endif 
     304 
     305   END SUBROUTINE lim_cons_final 
    236306 
    237307#else 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

    r5125 r5350  
    419419               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
    420420               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
    421                WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)               
     421               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)               
    422422               WRITE(numout,*) 
    423423               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    • Property svn:keywords set to Id
    r5123 r5350  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.4 , NEMO Consortium (2012) 
    42    !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $ 
     42   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
    … …  
    115115      zbg_ihc      = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J] 
    116116      zbg_shc      = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 
    117       zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     117      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    118118      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    119119 
    … …  
    245245         WRITE(numout,*) '~~~~~~~~~~~~' 
    246246      ENDIF 
    247  
    248       ! ---------------------------------- ! 
    249       ! 2 - initial conservation variables ! 
    250       ! ---------------------------------- ! 
    251       !frc_vol = 0._wp                                          ! volume       trend due to forcing 
    252       !frc_sal = 0._wp                                          ! salt content   -    -   -    -          
    253       !bg_grme = 0._wp                                          ! ice growth + melt volume trend 
    254247      ! 
    255248      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r5123 r5350  
    314314            DO ji = 1, jpi 
    315315               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    316                ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     316               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness 
    317317               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    318                sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin ! salinity 
    319                o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
     318               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity 
     319               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day) 
    320320               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    321321 
    … …  
    333333               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
    334334               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    335             END DO ! ji 
    336          END DO ! jj 
    337       END DO ! jl 
     335            END DO 
     336         END DO 
     337      END DO 
    338338 
    339339      ! Snow temperature and heat content 
    … …  
    348348                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
    349349                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
    350                END DO ! ji 
    351             END DO ! jj 
    352          END DO ! jl 
    353       END DO ! jk 
     350               END DO 
     351            END DO 
     352         END DO 
     353      END DO 
    354354 
    355355      ! Ice salinity, temperature and heat content 
    … …  
    369369                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
    370370                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
    371                END DO ! ji 
    372             END DO ! jj 
    373          END DO ! jl 
    374       END DO ! jk 
     371               END DO 
     372            END DO 
     373         END DO 
     374      END DO 
    375375 
    376376      tn_ice (:,:,:) = t_su (:,:,:) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r5134 r5350  
    127127      REAL(wp) ::   za, zfac              ! local scalar 
    128128      CHARACTER (len = 15) ::   fieldid 
    129       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s) 
    130                                                              ! (ridging ice area - area of new ridges) / dt 
    131       REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
    132       REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear 
    133       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    134       REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
    135       REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    136       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
     129      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s) 
     130                                                               ! (ridging ice area - area of new ridges) / dt 
     131      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
     132      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear 
     133      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
     134      REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
     135      REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
     136      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    137137      ! 
    138138      INTEGER, PARAMETER ::   nitermax = 20     
    … …  
    142142      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    143143 
    144       CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     144      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    145145 
    146146      IF(ln_ctl) THEN 
    … …  
    153153      ! conservation test 
    154154      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     155 
     156      CALL lim_var_zapsmall 
     157      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    155158 
    156159      !-----------------------------------------------------------------------------! 
    … …  
    235238               ! Reduce the closing rate if more than 100% of the open water  
    236239               ! would be removed.  Reduce the opening rate proportionately. 
    237                IF ( ato_i(ji,jj) > epsi10 .AND. athorn(ji,jj,0) > 0.0 ) THEN 
    238                   za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
    239                   IF ( za > ato_i(ji,jj)) THEN 
    240                      zfac = ato_i(ji,jj) / za 
    241                      closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
    242                      opning(ji,jj) = opning(ji,jj) * zfac 
    243                   ENDIF 
     240               za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
     241               IF( za > epsi20 ) THEN 
     242                  zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 
     243                  closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     244                  opning       (ji,jj) = opning       (ji,jj) * zfac 
    244245               ENDIF 
    245246 
    … …  
    251252         ! Reduce the closing rate if more than 100% of any ice category  
    252253         ! would be removed.  Reduce the opening rate proportionately. 
    253  
    254254         DO jl = 1, jpl 
    255255            DO jj = 1, jpj 
    256256               DO ji = 1, jpi 
    257                   IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 
    258                      za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    259                      IF ( za  >  a_i(ji,jj,jl) ) THEN 
    260                         zfac = a_i(ji,jj,jl) / za 
    261                         closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
    262                         opning       (ji,jj) = opning       (ji,jj) * zfac 
    263                      ENDIF 
     257                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
     258                  IF( za  >  epsi20 ) THEN 
     259                     zfac = MIN( 1._wp, a_i(ji,jj,jl) / za ) 
     260                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     261                     opning       (ji,jj) = opning       (ji,jj) * zfac 
    264262                  ENDIF 
    265263               END DO 
    … …  
    368366      ENDIF 
    369367 
    370       ! updates 
    371       CALL lim_var_glo2eqv 
    372       CALL lim_var_zapsmall 
    373368      CALL lim_var_agg( 1 )  
    374369 
    … …  
    377372      !-----------------------------------------------------------------------------! 
    378373      IF(ln_ctl) THEN  
     374         CALL lim_var_glo2eqv 
     375 
    379376         CALL prt_ctl_info(' ') 
    380377         CALL prt_ctl_info(' - Cell values : ') 
    … …  
    531528         DO jj = 2, jpjm1 
    532529            DO ji = 2, jpim1 
    533                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present 
     530               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
    534531                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    535532                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
    … …  
    566563         DO jj = 1, jpj - 1 
    567564            DO ji = 1, jpi - 1 
    568                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN       ! ice is present 
     565               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
    569566                  numts_rm = 1 ! number of time steps for the running mean 
    570567                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
    … …  
    637634 
    638635      Gsum(:,:,-1) = 0._wp 
    639  
    640       DO jj = 1, jpj 
    641          DO ji = 1, jpi 
    642             IF( ato_i(ji,jj) > epsi10 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj) 
    643             ELSE                               ;   Gsum(ji,jj,0) = 0._wp 
    644             ENDIF 
    645          END DO 
    646       END DO 
     636      Gsum(:,:,0 ) = ato_i(:,:) 
    647637 
    648638      ! for each value of h, you have to add ice concentration then 
    649639      DO jl = 1, jpl 
    650          DO jj = 1, jpj  
    651             DO ji = 1, jpi 
    652                IF( a_i(ji,jj,jl) > epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 
    653                ELSE                                ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 
    654                ENDIF 
    655             END DO 
    656          END DO 
     640         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    657641      END DO 
    658642 
    … …  
    828812      LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging) 
    829813      ! 
    830       LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny 
    831       LOGICAL ::   large_afrac    ! flag for afrac > 1 
    832       LOGICAL ::   large_afrft    ! flag for afrac > 1 
    833814      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
    834815      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    … …  
    850831      REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
    851832      REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
    852       REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging ice 
    853833      REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    854834 
    … …  
    859839      REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges 
    860840      REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges 
     841      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    861842 
    862843      REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted 
    … …  
    864845      REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
    865846      REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
    866       REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! areal age content of rafted ice & rafting ice 
     847      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted 
    867848 
    868849      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice 
    … …  
    872853      !!---------------------------------------------------------------------- 
    873854 
    874       CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    875       CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    876       CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    877       CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    878       CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    879       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    880       CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
    881       CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
     855      CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj ) 
     856      CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final ) 
     857      CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     858      CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     859      CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     860      CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     861      CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw ) 
     862      CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    882863 
    883864      ! Conservation check 
    … …  
    898879      ! 1) Compute change in open water area due to closing and opening. 
    899880      !------------------------------------------------------------------------------- 
    900  
    901       neg_ato_i = .false. 
    902  
    903881      DO jj = 1, jpj 
    904882         DO ji = 1, jpi 
    905883            ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        & 
    906884               &                        + opning(ji,jj)                          * rdt_ice 
    907             IF( ato_i(ji,jj) < -epsi10 ) THEN 
    908                neg_ato_i = .TRUE. 
    909             ELSEIF( ato_i(ji,jj) < 0._wp ) THEN    ! roundoff error 
     885            IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug 
     886               IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj) 
     887            ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error 
    910888               ato_i(ji,jj) = 0._wp 
    911889            ENDIF 
    912890         END DO 
    913891      END DO 
    914  
    915       ! if negative open water area alert it 
    916       IF( neg_ato_i .AND. lwp ) THEN       ! there is a bug 
    917          DO jj = 1, jpj  
    918             DO ji = 1, jpi 
    919                IF( ato_i(ji,jj) < -epsi10 ) THEN  
    920                   WRITE(numout,*) ''   
    921                   WRITE(numout,*) 'Ridging error: ato_i < 0' 
    922                   WRITE(numout,*) 'ato_i : ', ato_i(ji,jj) 
    923                ENDIF 
    924             END DO 
    925          END DO 
    926       ENDIF 
    927892 
    928893      !----------------------------------------------------------------- 
    929894      ! 2) Save initial state variables 
    930895      !----------------------------------------------------------------- 
    931  
    932       DO jl = 1, jpl 
    933          aicen_init(:,:,jl) = a_i(:,:,jl) 
    934          vicen_init(:,:,jl) = v_i(:,:,jl) 
    935          vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    936          ! 
    937          smv_i_init(:,:,jl) = smv_i(:,:,jl) 
    938          oa_i_init (:,:,jl) = oa_i (:,:,jl) 
    939       END DO 
    940  
    941       esnwn_init(:,:,:) = e_s(:,:,1,:) 
    942  
    943       DO jl = 1, jpl   
    944          DO jk = 1, nlay_i 
    945             eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 
    946          END DO 
    947       END DO 
     896      aicen_init(:,:,:)   = a_i  (:,:,:) 
     897      vicen_init(:,:,:)   = v_i  (:,:,:) 
     898      vsnwn_init(:,:,:)   = v_s  (:,:,:) 
     899      smv_i_init(:,:,:)   = smv_i(:,:,:) 
     900      esnwn_init(:,:,:)   = e_s  (:,:,1,:) 
     901      eicen_init(:,:,:,:) = e_i  (:,:,:,:) 
     902      oa_i_init (:,:,:)   = oa_i (:,:,:) 
    948903 
    949904      ! 
    … …  
    972927         END DO 
    973928 
    974          large_afrac = .false. 
    975          large_afrft = .false. 
    976  
    977929         DO ij = 1, icells 
    978930            ji = indxi(ij) 
    … …  
    988940            arft2(ji,jj) = arft1(ji,jj) / kraft 
    989941 
    990             oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    991             oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    992             oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1) 
    993             oirft2(ji,jj)= oirft1(ji,jj) / kraft 
    994  
    995942            !--------------------------------------------------------------- 
    996943            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
    … …  
    1000947            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    1001948 
    1002             IF (afrac(ji,jj) > kamax + epsi10) THEN  !riging 
    1003                large_afrac = .true. 
    1004             ELSEIF (afrac(ji,jj) > kamax) THEN  ! roundoff error 
     949            IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug 
     950               IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
     951            ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error 
    1005952               afrac(ji,jj) = kamax 
    1006953            ENDIF 
    1007             IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 
    1008                large_afrft = .true. 
    1009             ELSEIF (afrft(ji,jj) > kamax) THEN  ! roundoff error 
     954 
     955            IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 
     956               IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)  
     957            ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error 
    1010958               afrft(ji,jj) = kamax 
    1011959            ENDIF 
    … …  
    1019967            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 
    1020968 
    1021             vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1022             esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1023             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
    1024             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
     969            vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     970            esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     971            srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     972            oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) 
     973            oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1)  
    1025974 
    1026975            ! rafting volumes, heat contents ... 
    1027             virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    1028             vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    1029             esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    1030             smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
     976            virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
     977            vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     978            esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     979            smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
     980            oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj)  
     981            oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft  
    1031982 
    1032983            ! substract everything 
    1033             a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj) 
    1034             v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj) 
    1035             v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj) 
    1036             e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj)  - esrft(ji,jj) 
     984            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj) 
     985            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj) 
     986            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj) 
     987            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj) 
     988            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj) 
    1037989            oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj) 
    1038             smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj) 
    1039990 
    1040991            !----------------------------------------------------------------- 
    1041992            ! 3.5) Compute properties of new ridges 
    1042993            !----------------------------------------------------------------- 
    1043             !------------- 
     994            !--------- 
    1044995            ! Salinity 
    1045             !------------- 
     996            !--------- 
    1046997            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
    1047998            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    … …  
    10501001             
    10511002            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
    1052             wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
     1003            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids              
    10531004 
    10541005            !------------------------------------             
    … …  
    11341085         ENDIF 
    11351086 
    1136          IF( large_afrac .AND. lwp ) THEN   ! there is a bug 
    1137             DO ij = 1, icells 
    1138                ji = indxi(ij) 
    1139                jj = indxj(ij) 
    1140                IF( afrac(ji,jj) > kamax + epsi10 ) THEN  
    1141                   WRITE(numout,*) '' 
    1142                   WRITE(numout,*) ' ardg > a_i' 
    1143                   WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
    1144                ENDIF 
    1145             END DO 
    1146          ENDIF 
    1147          IF( large_afrft .AND. lwp ) THEN  ! there is a bug 
    1148             DO ij = 1, icells 
    1149                ji = indxi(ij) 
    1150                jj = indxj(ij) 
    1151                IF( afrft(ji,jj) > kamax + epsi10 ) THEN  
    1152                   WRITE(numout,*) '' 
    1153                   WRITE(numout,*) ' arft > a_i' 
    1154                   WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
    1155                ENDIF 
    1156             END DO 
    1157          ENDIF 
    1158  
    11591087         !------------------------------------------------------------------------------- 
    11601088         ! 4) Add area, volume, and energy of new ridge to each category jl2 
    … …  
    11901118               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
    11911119 
    1192             END DO ! ij 
     1120            END DO 
    11931121 
    11941122            ! Transfer ice energy to category jl2 by ridging 
    … …  
    12171145                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 
    12181146                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
    1219                   oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)     
     1147                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj) 
    12201148               ENDIF 
    12211149               ! 
    … …  
    12571185      ENDIF 
    12581186      ! 
    1259       CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    1260       CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    1261       CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    1262       CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    1263       CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1264       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    1265       CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
    1266       CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
     1187      CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj ) 
     1188      CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final ) 
     1189      CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     1190      CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     1191      CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     1192      CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     1193      CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw ) 
     1194      CALL wrk_dealloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    12671195      ! 
    12681196   END SUBROUTINE lim_itd_me_ridgeshift 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r5134 r5350  
    130130               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )    !0 if no ice and 1 if yes 
    131131               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
    132 !clem               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
    133132               zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
    134133            END DO 
    … …  
    737736      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    738737      !!------------------------------------------------------------------ 
    739       !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 
    740738       
    741739      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
    … …  
    844842            zdvice(:,:,jl) = 0._wp 
    845843         ENDIF 
    846  
    847 !         ! clem-change begin: why not doing that? 
    848 !         DO jj = 1, jpj 
    849 !            DO ji = 1, jpi 
    850 !               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    851 !                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
    852 !                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    853 !               ENDIF 
    854 !            END DO 
    855 !         END DO 
    856          ! clem-change end 
    857844 
    858845      END DO 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r5128 r5350  
    5555      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5656      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     57      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file  
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
    … …  
    6465      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    & 
    6566         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    66          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    67          IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    68          ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     67         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
     68            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     69            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     70            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     71            ENDIF 
     72            ! create the file 
     73            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
     74            clpath = TRIM(cn_icerst_outdir)  
     75            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
     76            IF(lwp) THEN 
     77               WRITE(numout,*) 
     78               SELECT CASE ( jprstlib ) 
     79               CASE ( jprstdimg ) 
     80                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname 
     81               CASE DEFAULT 
     82                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname 
     83               END SELECT 
     84               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     85                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     86               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
     87               ENDIF 
     88            ENDIF 
     89            ! 
     90            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     91            lrst_ice = .TRUE. 
    6992         ENDIF 
    70          ! create the file 
    71          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
    72          IF(lwp) THEN 
    73             WRITE(numout,*) 
    74             SELECT CASE ( jprstlib ) 
    75             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname 
    76             CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    77             END SELECT 
    78             IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
    79                WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
    80             ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    81             ENDIF 
    82          ENDIF 
    83          ! 
    84          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
    85          lrst_ice = .TRUE. 
    8693      ENDIF 
    8794      ! 
    … …  
    143150         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    144151      END DO 
    145        
     152 
    146153      DO jl = 1, jpl  
    147154         WRITE(zchar,'(I1)') jl 
    … …  
    327334        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    328335        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    329         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     336        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    330337        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    331338      ENDIF 
    332339 
    333       CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib ) 
     340      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
    334341 
    335342      CALL iom_get( numrir, 'nn_fsbc', zfice ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5128 r5350  
    4242   USE domvvl           ! Variable volume 
    4343   USE limctl 
     44   USE limcons 
    4445 
    4546   IMPLICIT NONE 
    … …  
    146147            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
    147148 
     149            ! Add the residual from heat diffusion equation (W.m-2) 
     150            !------------------------------------------------------- 
     151            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 
     152 
    148153            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    149154            !--------------------------------------------------- 
    … …  
    164169            !  computing freshwater exchanges at the ice/ocean interface 
    165170            IF( lk_cpl ) THEN  
    166                zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    167                   &   + wfx_snw(ji,jj) 
     171                zemp =   emp_tot(ji,jj)                                    &   ! net mass flux over grid cell 
     172                   &   - emp_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) )         &   ! minus the mass flux intercepted by sea ice 
     173                   &   + sprecip(ji,jj) * ( pfrld(ji,jj) - pfrld(ji,jj)**rn_betas )   ! 
    168174            ELSE 
    169175               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
    … …  
    177183 
    178184            ! mass flux at the ocean/ice interface 
    179             fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model 
    180             emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     185            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model 
     186            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)             ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    181187             
    182188         END DO 
    … …  
    222228      ENDIF 
    223229 
    224       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )   ! control print 
     230      ! conservation test 
     231      IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 
     232 
     233      ! control prints 
     234      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    225235 
    226236      IF(ln_ctl) THEN 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5134 r5350  
    8989      REAL(wp) :: zfric_u, zqld, zqfr 
    9090      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    91       REAL(wp), PARAMETER :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
    92       REAL(wp), PARAMETER :: zch        = 0.0057_wp    ! heat transfer coefficient 
     91      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
     92      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
    9393      ! 
    9494      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9595      !!------------------------------------------------------------------- 
    96       CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 
     96      CALL wrk_alloc( jpi,jpj, zqsr, zqns ) 
    9797 
    9898      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    … …  
    101101      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    102102 
     103      CALL lim_var_glo2eqv 
    103104      !------------------------------------------------------------------------! 
    104105      ! 1) Initialization of some variables                                    ! 
    … …  
    209210            ! Net heat flux on top of ice-ocean [W.m-2] 
    210211            ! ----------------------------------------- 
    211             !     First  step here      : heat flux at the ocean surface + precip 
    212             !     Second step below     : heat flux at the ice   surface (after limthd_dif)  
     212            !     heat flux at the ocean surface + precip 
     213            !   + heat flux at the ice   surface  
    213214            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
    214215               ! heat flux above the ocean 
    … …  
    216217               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    217218               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
    218                &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) 
     219               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 )          & 
     220               ! heat flux above the ice 
     221               &    +   SUM(    a_i_b(ji,jj,:)   * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 
    219222 
    220223            ! ----------------------------------------------------------------------------- 
    … …  
    226229            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       &  
    227230               ! Non solar heat flux received by the ocean 
    228                &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            & 
     231               &    +        pfrld(ji,jj) * zqns(ji,jj)                                                                            & 
    229232               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    230233               &    +      ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
    … …  
    311314            ! --- lateral melting if monocat --- ! 
    312315            !------------------------------------! 
    313             IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 ) ) THEN 
     316            IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    314317               CALL lim_thd_lam( 1, nbpb ) 
    315318            END IF 
    … …  
    324327         ENDIF 
    325328         ! 
    326       END DO 
     329      END DO !jl 
    327330 
    328331      !------------------------------------------------------------------------------! 
    … …  
    350353      END DO 
    351354  
    352       !------------------------ 
    353       ! Ice natural aging               
    354       !------------------------ 
    355       oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice /rday 
    356  
    357355      !---------------------------------- 
    358356      ! Change thickness to volume 
    359357      !---------------------------------- 
    360       CALL lim_var_eqv2glo 
     358      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
     359      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
     360      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
     361 
     362      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 
     363      DO jl  = 1, jpl 
     364         DO jj = 1, jpj 
     365            DO ji = 1, jpi 
     366               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) ) 
     367               oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) 
     368            END DO 
     369         END DO 
     370      END DO 
    361371 
    362372      CALL lim_var_zapsmall 
     373 
    363374      !-------------------------------------------- 
    364375      ! Diagnostic thermodynamic growth rates 
    … …  
    399410      ! 
    400411      ! 
    401       CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
    402  
    403412      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     413 
     414      CALL wrk_dealloc( jpi,jpj, zqsr, zqns ) 
     415 
    404416      !------------------------------------------------------------------------------| 
    405417      !  6) Transport of ice between thickness categories.                           | 
    406418      !------------------------------------------------------------------------------| 
     419      ! Given thermodynamic growth rates, transport ice between thickness categories. 
    407420      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    408421 
    409       ! Given thermodynamic growth rates, transport ice between thickness categories. 
    410       IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt ) 
    411       ! 
    412       CALL lim_var_glo2eqv    ! only for info 
    413       CALL lim_var_agg(1) 
     422      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt ) 
    414423 
    415424      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     425 
    416426      !------------------------------------------------------------------------------| 
    417427      !  7) Add frazil ice growing in leads. 
    418428      !------------------------------------------------------------------------------| 
    419429      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     430 
    420431      CALL lim_thd_lac 
    421       CALL lim_var_glo2eqv    ! only for info 
    422432       
    423       ! conservation test 
    424433      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    425434 
    426       IF(ln_ctl) THEN   ! Control print 
     435      ! Control print 
     436      IF(ln_ctl) THEN 
     437         CALL lim_var_glo2eqv 
     438 
    427439         CALL prt_ctl_info(' ') 
    428440         CALL prt_ctl_info(' - Cell values : ') 
    … …  
    503515      REAL(wp)            ::   zhi_bef            ! ice thickness before thermo 
    504516      REAL(wp)            ::   zdh_mel, zda_mel   ! net melting 
    505       REAL(wp)            ::   zv                 ! ice volume  
     517      REAL(wp)            ::   zvi, zvs           ! ice/snow volumes  
    506518 
    507519      DO ji = kideb, kiut 
    508520         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 
    509          IF( zdh_mel < 0._wp )  THEN 
    510             zv         = a_i_1d(ji) * ht_i_1d(ji) 
     521         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN 
     522            zvi          = a_i_1d(ji) * ht_i_1d(ji) 
     523            zvs          = a_i_1d(ji) * ht_s_1d(ji) 
    511524            ! lateral melting = concentration change 
    512525            zhi_bef     = ht_i_1d(ji) - zdh_mel 
    513             zda_mel     =  a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi10 ) ) 
    514             a_i_1d(ji)  = MAX( 0._wp, a_i_1d(ji) + zda_mel )  
    515             ! adjust thickness 
    516             rswitch     = MAX( 0._wp , SIGN( 1._wp , a_i_1d(ji) - epsi20 ) ) 
    517             ht_i_1d(ji) = rswitch * zv / MAX( a_i_1d(ji), epsi20 ) 
     526            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 
     527            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 
     528            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel )  
     529             ! adjust thickness 
     530            ht_i_1d(ji) = zvi / a_i_1d(ji)             
     531            ht_s_1d(ji) = zvs / a_i_1d(ji)             
    518532            ! retrieve total concentration 
    519533            at_i_1d(ji) = a_i_1d(ji) 
    … …  
    601615         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
    602616         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     617         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 
    603618         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
    604619 
    … …  
    651666         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
    652667         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 
     668         CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj ) 
    653669         ! 
    654670         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
    … …  
    674690      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    675691      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       & 
    676          &                rn_himin, parsub, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
    677          &                nn_monocat 
     692         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
     693         &                nn_monocat, ln_it_qnsice 
    678694      !!------------------------------------------------------------------- 
    679695      ! 
    … …  
    698714      ENDIF 
    699715 
    700       IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
    701716      ! 
    702717      IF(lwp) THEN                          ! control print 
    … …  
    710725         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin  
    711726         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    712          WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub   
    713727         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas 
    714728         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
    … …  
    718732         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    719733         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
     734         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
    720735      ENDIF 
    721736      ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r5134 r5350  
    8686      REAL(wp) ::   zsstK        ! SST in Kelvin 
    8787 
    88       REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
    8988      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
    9089      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2) 
    … …  
    9291      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
    9392      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
    94       INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting  
    9593 
    9694      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
    … …  
    10098      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
    10199      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness 
     100      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting  
    102101 
    103102      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2) 
    … …  
    118117      END SELECT 
    119118 
    120       CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
     119      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
    121120      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
    122       CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i ) 
    123       CALL wrk_alloc( jpij, icount ) 
     121      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 
     122      CALL wrk_alloc( jpij, nlay_i, icount ) 
    124123       
    125124      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
    … …  
    129128      zq_rema(:) = 0._wp 
    130129 
    131       zh_s     (:) = 0._wp        
    132130      zdh_s_pre(:) = 0._wp 
    133131      zdh_s_mel(:) = 0._wp 
    … …  
    138136      zh_i      (:,:) = 0._wp        
    139137      zdeltah   (:,:) = 0._wp        
    140       icount    (:)   = 0 
     138      icount    (:,:) = 0 
     139 
     140      ! Initialize enthalpy at nlay_i+1 
     141      DO ji = kideb, kiut 
     142         q_i_1d(ji,nlay_i+1) = 0._wp 
     143      END DO 
    141144 
    142145      ! initialize layer thicknesses and enthalpies 
    … …  
    155158      ! 
    156159      DO ji = kideb, kiut 
    157          rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
    158          ztmelts       = rswitch * rt0 + ( 1._wp - rswitch ) * rt0 
    159  
    160160         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    161161         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    162162 
    163          zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) ) 
     163         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    164164         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
    165165      END DO 
    … …  
    187187      !------------------------------------------------------------! 
    188188      ! 
    189       DO ji = kideb, kiut      
    190          zh_s(ji) = ht_s_1d(ji) * r1_nlay_s 
    191       END DO 
    192       ! 
    193189      DO jk = 1, nlay_s 
    194190         DO ji = kideb, kiut 
    195             zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji) 
     191            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s 
    196192         END DO 
    197193      END DO 
    … …  
    222218      ! Martin Vancoppenolle, December 2006 
    223219 
     220      zdeltah(:,:) = 0._wp 
    224221      DO ji = kideb, kiut 
    225222         !----------- 
    … …  
    236233         ! mass flux, <0 
    237234         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice 
    238          ! update thickness 
    239          ht_s_1d    (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 
    240235 
    241236         !--------------------- 
    … …  
    243238         !--------------------- 
    244239         ! thickness change 
    245          IF( zdh_s_pre(ji) > 0._wp ) THEN 
    246240         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 
    247          zdh_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 
    248          zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting  
     241         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 
     242         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting  
    249243         ! heat used to melt snow (W.m-2, >0) 
    250          hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
     244         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
    251245         ! snow melting only = water into the ocean (then without snow precip), >0 
    252          wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice 
    253           
    254          ! updates available heat + thickness 
    255          zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )       
    256          ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) ) 
    257          zh_s  (ji) = ht_s_1d(ji) * r1_nlay_s 
    258  
    259          ENDIF 
    260       END DO 
    261  
    262       ! If heat still available, then melt more snow 
    263       zdeltah(:,:) = 0._wp ! important 
     246         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice     
     247         ! updates available heat + precipitations after melting 
     248         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )       
     249         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
     250 
     251         ! update thickness 
     252         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 
     253      END DO 
     254 
     255      ! If heat still available (zq_su > 0), then melt more snow 
     256      zdeltah(:,:) = 0._wp 
    264257      DO jk = 1, nlay_s 
    265258         DO ji = kideb, kiut 
    … …  
    268261            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) )  
    269262            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 ) 
    270             zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 
     263            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting 
    271264            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)     
    272265            ! heat used to melt snow(W.m-2, >0) 
    … …  
    274267            ! snow melting only = water into the ocean (then without snow precip) 
    275268            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
    276  
    277269            ! updates available heat + thickness 
    278270            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 
    279271            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 
    280  
    281272         END DO 
    282273      END DO 
    … …  
    286277      !---------------------- 
    287278      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    288       ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean) 
     279      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 
    289280      ! clem comment: ice should also sublimate 
     281      zdeltah(:,:) = 0._wp 
    290282      IF( lk_cpl ) THEN 
    291283         ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
    … …  
    294286         ! forced  mode: snow thickness change due to sublimation 
    295287         DO ji = kideb, kiut 
    296             zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 
     288            zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 
    297289            ! Heat flux by sublimation [W.m-2], < 0 
    298290            !      sublimate first snow that had fallen, then pre-existing snow 
    299             zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   & 
    300                &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) )  & 
    301                &  * a_i_1d(ji) * r1_rdtice 
    302             hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 
     291            zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
     292            hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  & 
     293               &                              ) * a_i_1d(ji) * r1_rdtice 
    303294            ! Mass flux by sublimation 
    304295            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 
    305296            ! new snow thickness 
    306             ht_s_1d(ji)     =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
     297            ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
     298            ! update precipitations after sublimation and correct sublimation 
     299            zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
     300            zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 
    307301         END DO 
    308302      ENDIF 
    … …  
    310304      ! --- Update snow diags --- ! 
    311305      DO ji = kideb, kiut 
    312          dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
    313          zh_s(ji)       = ht_s_1d(ji) * r1_nlay_s 
    314       END DO ! ji 
     306         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
     307      END DO 
    315308 
    316309      !------------------------------------------- 
    … …  
    323316            rswitch       = MAX(  0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 )  ) 
    324317            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *                          & 
    325               &            ( (   MAX( 0._wp, dh_s_tot(ji) )               ) * zqprec(ji) +  & 
    326               &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 
     318              &            ( (   zdh_s_pre(ji)             ) * zqprec(ji) +  & 
     319              &              (   ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 
    327320            zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk) 
    328321         END DO 
    … …  
    334327      zdeltah(:,:) = 0._wp ! important 
    335328      DO jk = 1, nlay_i 
    336          DO ji = kideb, kiut  
    337             zEi            = - q_i_1d(ji,jk) * r1_rhoic             ! Specific enthalpy of layer k [J/kg, <0] 
    338  
    339             ztmelts        = - tmut * s_i_1d(ji,jk) + rt0           ! Melting point of layer k [K] 
    340  
    341             zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0] 
    342  
    343             zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
    344  
    345             zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
    346  
    347             zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0] 
    348  
    349             zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
    350  
    351             zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
    352  
    353             dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
    354  
    355             zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
    356  
    357             zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
    358  
    359             ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    360             sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
    361  
    362             ! Contribution to heat flux [W.m-2], < 0 
    363             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
    364  
    365             ! Total heat flux used in this process [W.m-2], > 0   
    366             hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
    367  
    368             ! Contribution to mass flux 
    369             wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
    370             
     329         DO ji = kideb, kiut 
     330            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K] 
     331             
     332            IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 
     333 
     334               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]        
     335               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0) 
     336                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted) 
     337               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing      
     338                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this 
     339               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0 
     340                          
     341               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
     342                
     343               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     344 
     345               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
     346               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice 
     347                
     348               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     349               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
     350                
     351               ! Contribution to mass flux 
     352               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     353 
     354            ELSE                                !!! Surface melting 
     355                
     356               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0] 
     357               zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0] 
     358               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
     359                
     360               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
     361                
     362               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0] 
     363                
     364               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
     365                
     366               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
     367                
     368               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
     369                
     370               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     371                
     372               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
     373                
     374               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     375               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
     376                
     377               ! Contribution to heat flux [W.m-2], < 0 
     378               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     379                
     380               ! Total heat flux used in this process [W.m-2], > 0   
     381               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     382                
     383               ! Contribution to mass flux 
     384               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     385                
     386            END IF 
    371387            ! record which layers have disappeared (for bottom melting)  
    372388            !    => icount=0 : no layer has vanished 
    373389            !    => icount=5 : 5 layers have vanished 
    374             rswitch     = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )  
    375             icount(ji)  = icount(ji) + NINT( rswitch ) 
    376             zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
     390            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )  
     391            icount(ji,jk) = NINT( rswitch ) 
     392            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
    377393 
    378394            ! update heat content (J.m-2) and layer thickness 
    … …  
    405421      ! -> need for an iterative procedure, which converges quickly 
    406422 
    407       IF ( nn_icesal == 2 ) THEN 
    408          num_iter_max = 5 
    409       ELSE 
    410          num_iter_max = 1 
    411       ENDIF 
    412  
    413       ! Just to be sure that enthalpy at nlay_i+1 is null 
    414       DO ji = kideb, kiut 
    415          q_i_1d(ji,nlay_i+1) = 0._wp 
    416       END DO 
     423      num_iter_max = 1 
     424      IF( nn_icesal == 2 ) num_iter_max = 5 
    417425 
    418426      ! Iterative procedure 
    … …  
    483491             
    484492            ! Contribution to salt flux, <0 
    485             sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice 
     493            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice 
    486494 
    487495            ! Contribution to mass flux, <0 
    … …  
    500508      DO jk = nlay_i, 1, -1 
    501509         DO ji = kideb, kiut 
    502             IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared by surface melting  
     510            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting  
    503511 
    504512               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K) 
    … …  
    507515 
    508516                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0) 
    509  
    510                   !!zEw               = rcp * ( t_i_1d(ji,jk) - rt0 )  ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0) 
    511  
    512517                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
    513518                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted) 
    514  
    515                   zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing      
    516                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this 
     519                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing      
     520                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this 
    517521 
    518522                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk) 
    519523 
    520                   zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     524                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0 
    521525 
    522526                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
    … …  
    524528 
    525529                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    526                   sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     530                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
    527531                                     
    528532                  ! Contribution to mass flux 
    … …  
    535539               ELSE                               !!! Basal melting 
    536540 
    537                   zEi               = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 
    538  
    539                   zEw               = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0) 
    540  
    541                   zdE               = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0) 
    542  
    543                   zfmdt             = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0) 
    544  
    545                   zdeltah(ji,jk)    = - zfmdt * r1_rhoic         ! Gross thickness change 
    546  
    547                   zdeltah(ji,jk)    = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 
     541                  zEi             = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 
     542                  zEw             = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0) 
     543                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0) 
     544 
     545                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0) 
     546 
     547                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change 
     548 
     549                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 
    548550                   
    549                   zq_bo(ji)         = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 
    550  
    551                   dh_i_bott(ji)     = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt 
    552  
    553                   zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
    554  
    555                   zQm               = zfmdt * zEw         ! Heat exchanged with ocean 
     551                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 
     552 
     553                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt 
     554 
     555                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     556 
     557                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean 
    556558 
    557559                  ! Contribution to heat flux to the ocean [W.m-2], <0   
    558                   hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     560                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
    559561 
    560562                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    561                   sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     563                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
    562564                   
    563565                  ! Total heat flux used in this process [W.m-2], >0   
    564                   hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     566                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
    565567                   
    566568                  ! Contribution to mass flux 
    567                   wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     569                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
    568570 
    569571                  ! update heat content (J.m-2) and layer thickness 
    … …  
    595597         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 ) 
    596598         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting 
    597          zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)     
    598599         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1) 
    599600         ht_s_1d   (ji)  = ht_s_1d(ji)   + zdeltah(ji,1) 
    … …  
    622623         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  ) 
    623624 
    624          ht_i_1d(ji)     = ht_i_1d(ji) + dh_snowice(ji) 
    625          ht_s_1d(ji)     = ht_s_1d(ji) - dh_snowice(ji) 
     625         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji) 
     626         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji) 
    626627 
    627628         ! Salinity of snow ice 
    … …  
    669670      ! Update temperature, energy 
    670671      !------------------------------------------- 
    671       !clem bug: we should take snow into account here 
    672672      DO ji = kideb, kiut 
    673673         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
    … …  
    688688      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 
    689689       
    690       CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
     690      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
    691691      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
    692       CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i ) 
    693       CALL wrk_dealloc( jpij, icount ) 
     692      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 
     693      CALL wrk_dealloc( jpij, nlay_i, icount ) 
    694694      ! 
    695695      ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r5128 r5350  
    120120      REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness 
    121121      REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface 
     122      REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface 
    122123      REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function 
    123124      REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function 
    … …  
    168169      CALL wrk_alloc( jpij, numeqmin, numeqmax ) 
    169170      CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
    170       CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zghe ) 
    171       CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 
    172       CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0) 
    173       CALL wrk_alloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis  ) 
    174       CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 
     171      CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 
     172      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 
     173      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 
     174      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  ) 
     175      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 
    175176 
    176177      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
    … …  
    242243      !------------------------------------------------------- 
    243244      DO ji = kideb , kiut 
    244          zfsw   (ji) =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface 
    245          zftrice(ji) =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer 
    246          dzf    (ji) = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux  
     245         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface 
     246         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer 
     247         dzf    (ji)    = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux  
     248         zqns_ice_b(ji) = qns_ice_1d(ji)                     ! store previous qns_ice_1d value 
    247249      END DO 
    248250 
    … …  
    452454         !------------------------------------------------------------------------------| 
    453455         ! 
    454          IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case 
     456         IF ( ln_it_qnsice ) THEN  
    455457            DO ji = kideb , kiut 
    456458               ! update of the non solar flux according to the update in T_su 
    … …  
    677679         END DO 
    678680 
    679          DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
     681         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1 
    680682            DO ji = kideb , kiut 
    681683               jk    =  numeq - nlay_s - 1 
    … …  
    757759      CALL lim_thd_enmelt( kideb, kiut ) 
    758760 
     761      ! --- diagnose the change in non-solar flux due to surface temperature change --- ! 
     762      IF ( ln_it_qnsice ) hfx_err_dif_1d(:) = hfx_err_dif_1d(:) - ( qns_ice_1d(:)  - zqns_ice_b(:) ) * a_i_1d(:)  
    759763 
    760764      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    … …  
    768772         ENDIF 
    769773         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
     774 
     775         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation) 
     776         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
    770777      END DO  
    771  
    772       ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 
    773       IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed 
    774          ! 
    775          DO ji = kideb, kiut 
    776             qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 
    777             fc_su     (ji) = fc_su(ji)      - zhfx_err(ji) 
    778          END DO 
    779          ! 
    780       ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed 
    781          ! 
    782          DO ji = kideb, kiut 
    783             fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji) 
    784          END DO 
    785          ! 
    786       ENDIF 
    787778 
    788779      !----------------------------------------- 
    … …  
    797788               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
    798789         ENDIF 
    799       END DO 
    800  
    801       ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m-2) 
    802       DO ji = kideb, kiut 
    803          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    804          hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
    805       END DO 
    806     
     790         ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation 
     791         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji) 
     792      END DO    
    807793      ! 
    808794      CALL wrk_dealloc( jpij, numeqmin, numeqmax ) 
    809795      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
    810796      CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zghe ) 
    811       CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   & 
    812          &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
    813       CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 
    814       CALL wrk_dealloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 
    815       CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 
     797      CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
     798      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 
     799      CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 
     800      CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid ) 
    816801      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
    817802 
    … …  
    834819      DO jk = 1, nlay_i             ! Sea ice energy of melting 
    835820         DO ji = kideb, kiut 
    836             ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0  
    837             rswitch      = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rt0) - epsi20 ) ) 
    838             q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                                & 
    839                &                   + lfus * ( 1.0 - rswitch * ( ztmelts-rt0 ) / MIN( t_i_1d(ji,jk) - rt0, -epsi20 ) )   & 
    840                &                   - rcp  *                   ( ztmelts-rt0 )  )  
     821            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0 
     822            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point 
     823                                                          !   (sometimes dif scheme produces abnormally high temperatures)    
     824            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                           & 
     825               &                    + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) )   & 
     826               &                    - rcp  *         ( ztmelts-rt0 )  )  
    841827         END DO 
    842828      END DO 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r5134 r5350  
    3131   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3232   USE limthd_ent 
     33   USE limvar 
    3334 
    3435   IMPLICIT NONE 
    … …  
    105106      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
    106107      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i 
    108108      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
    109109 
    … …  
    118118      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    119119      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
    120       CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
    121       CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     120      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 
     121      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d ) 
    122122      CALL wrk_alloc( jpi,jpj, zvrel ) 
    123123 
     124      CALL lim_var_agg(1) 
     125      CALL lim_var_glo2eqv 
    124126      !------------------------------------------------------------------------------| 
    125127      ! 2) Convert units for ice internal energy 
    … …  
    289291            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    290292            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    291             CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    292293            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    293294            DO jk = 1, nlay_i 
    294295               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    295             END DO ! jk 
    296          END DO ! jl 
     296            END DO 
     297         END DO 
    297298 
    298299         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
    … …  
    355356         DO ji = 1, nbpac 
    356357            zo_newice(ji) = 0._wp 
    357          END DO ! ji 
     358         END DO 
    358359 
    359360         !------------------- 
    … …  
    477478         ENDDO 
    478479 
    479          !------------ 
    480          ! Update age  
    481          !------------ 
    482          DO jl = 1, jpl 
    483             DO ji = 1, nbpac 
    484                rswitch          = MAX( 0._wp , SIGN( 1._wp , za_i_1d(ji,jl) - epsi20 ) )  ! 0 if no ice and 1 if yes 
    485                zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch    
    486             END DO  
    487          END DO    
    488  
    489480         !----------------- 
    490481         ! Update salinity 
    … …  
    503494            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
    504495            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
    505             CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 
    506496            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
    507497            DO jk = 1, nlay_i 
    … …  
    535525      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    536526      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
    537       CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
    538       CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     527      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 
     528      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d ) 
    539529      CALL wrk_dealloc( jpi,jpj, zvrel ) 
    540530      ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r5134 r5350  
    8080      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8181 
    82       CALL wrk_alloc( jpi,jpj,           zsm, zatold, zeiold, zesold ) 
    83       CALL wrk_alloc( jpi,jpj,jpl,       z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
    84       CALL wrk_alloc( jpi,jpj,1,         z0opw ) 
    85       CALL wrk_alloc( jpi,jpj,nlay_i+1,jpl, z0ei ) 
    86       CALL wrk_alloc( jpi,jpj,jpl,       zhimax, zviold, zvsold, zsmvold ) 
     82      CALL wrk_alloc( jpi,jpj,            zsm, zatold, zeiold, zesold ) 
     83      CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     84      CALL wrk_alloc( jpi,jpj,1,          z0opw ) 
     85      CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     86      CALL wrk_alloc( jpi,jpj,jpl,        zhimax, zviold, zvsold, zsmvold ) 
    8787 
    8888      IF( numit == nstart .AND. lwp ) THEN 
    … …  
    112112 
    113113         !--- Thickness correction init. ------------------------------- 
    114          CALL lim_var_glo2eqv 
    115114         zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     115         DO jl = 1, jpl 
     116            DO jj = 1, jpj 
     117               DO ji = 1, jpi 
     118                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     119                  ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     120                  ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     121               END DO 
     122            END DO 
     123         END DO 
    116124         !--------------------------------------------------------------------- 
    117          ! Record max of the surrounding ice thicknesses for correction in limupdate 
     125         ! Record max of the surrounding ice thicknesses for correction 
    118126         ! in case advection creates ice too thick. 
    119127         !--------------------------------------------------------------------- 
    … …  
    142150 
    143151         IF( zcfl > 0.5_wp .AND. lwp )   ncfl = ncfl + 1 
    144          IF( numit == nlast .AND. lwp ) THEN 
    145             IF( ncfl > 0 ) THEN    
    146                WRITE(cltmp,'(i6.1)') ncfl 
    147                CALL ctl_stop('STOP',TRIM(cltmp) ) 
    148                CALL ctl_warn( 'lim_trp: ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
    149             ELSE 
    150                WRITE(numout,*) 'lim_trp : CFL criteria for ice advection is always smaller than 1/2 ' 
    151             ENDIF 
    152          ENDIF 
     152!!         IF( lwp ) THEN 
     153!!            IF( ncfl > 0 ) THEN    
     154!!               WRITE(cltmp,'(i6.1)') ncfl 
     155!!               CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
     156!!            ELSE 
     157!!            !  WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 ' 
     158!!            ENDIF 
     159!!         ENDIF 
    153160 
    154161         !------------------------- 
    … …  
    229236                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    230237                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    231  
    232238                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    233239                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    … …  
    346352!!gm & cr  
    347353 
     354         ! --- diags --- 
     355         DO jj = 1, jpj 
     356            DO ji = 1, jpi 
     357               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 
     358               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 
     359 
     360               diag_trp_vi (ji,jj) = SUM(   v_i(ji,jj,:) -  zviold(ji,jj,:) ) * r1_rdtice 
     361               diag_trp_vs (ji,jj) = SUM(   v_s(ji,jj,:) -  zvsold(ji,jj,:) ) * r1_rdtice 
     362               diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 
     363            END DO 
     364         END DO 
     365 
    348366         ! zap small areas 
    349367         CALL lim_var_zapsmall 
    350368 
    351369         !--- Thickness correction in case too high -------------------------------------------------------- 
    352          CALL lim_var_glo2eqv 
    353370         DO jl = 1, jpl 
    354371            DO jj = 1, jpj 
    … …  
    357374                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    358375 
     376                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     377                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     378                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     379                      
    359380                     zvi  = v_i  (ji,jj,jl) 
    360381                     zvs  = v_s  (ji,jj,jl) 
    … …  
    366387 
    367388                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 
    368                         & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN                                           
     389                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 
    369390 
    370391                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 
    … …  
    406427         ENDIF 
    407428 
    408          ! --- diags --- 
    409          DO jj = 1, jpj 
    410             DO ji = 1, jpi 
    411                diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 
    412                diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 
    413  
    414                diag_trp_vi (ji,jj) = SUM(   v_i(ji,jj,:) -  zviold(ji,jj,:) ) * r1_rdtice 
    415                diag_trp_vs (ji,jj) = SUM(   v_s(ji,jj,:) -  zvsold(ji,jj,:) ) * r1_rdtice 
    416                diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 
    417             END DO 
    418          END DO 
    419  
    420429         ! --- agglomerate variables ----------------- 
    421430         vt_i (:,:) = 0._wp 
    … …  
    445454      ENDIF 
    446455 
    447       CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    448  
    449456      ! ------------------------------------------------- 
    450457      ! control prints 
    … …  
    452459      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
    453460      ! 
    454       CALL wrk_dealloc( jpi,jpj,           zsm, zatold, zeiold, zesold ) 
    455       CALL wrk_dealloc( jpi,jpj,jpl,       z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
    456       CALL wrk_dealloc( jpi,jpj,1,         z0opw ) 
    457       CALL wrk_dealloc( jpi,jpj,nlay_i+1,jpl, z0ei ) 
    458       CALL wrk_dealloc( jpi,jpj,jpl,       zviold, zvsold, zhimax, zsmvold ) 
     461      CALL wrk_dealloc( jpi,jpj,            zsm, zatold, zeiold, zesold ) 
     462      CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     463      CALL wrk_dealloc( jpi,jpj,1,          z0opw ) 
     464      CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     465      CALL wrk_dealloc( jpi,jpj,jpl,        zviold, zvsold, zhimax, zsmvold ) 
    459466      ! 
    460467      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    • Property svn:keywords set to Id
    r5134 r5350  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    41    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     41   !! $Id$ 
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    … …  
    6969      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    7070 
    71       CALL lim_var_glo2eqv 
    7271      !---------------------------------------------------- 
    7372      ! ice concentration should not exceed amax  
    … …  
    8281            DO ji = 1, jpi 
    8382               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    84                   a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     83                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     84                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    8585               ENDIF 
    8686            END DO 
    … …  
    8888      END DO 
    8989     
    90       !---------------------------------------------------- 
    91       ! Rebin categories with thickness out of bounds 
    92       !---------------------------------------------------- 
    93       IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
    94  
    95       !----------------- 
    96       ! zap small values 
    97       !----------------- 
    98       CALL lim_var_zapsmall 
    99  
    10090      !--------------------- 
    10191      ! Ice salinity bounds 
    … …  
    10696               DO ji = 1, jpi 
    10797                  zsal            = smv_i(ji,jj,jl) 
    108                   smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    10998                  ! salinity stays in bounds 
    11099                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    … …  
    117106      ENDIF 
    118107 
     108      !---------------------------------------------------- 
     109      ! Rebin categories with thickness out of bounds 
     110      !---------------------------------------------------- 
     111      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
     112 
     113      !----------------- 
     114      ! zap small values 
     115      !----------------- 
     116      CALL lim_var_zapsmall 
     117 
     118      ! ------------------------------------------------- 
     119      ! Diagnostics 
     120      ! ------------------------------------------------- 
     121      DO jl  = 1, jpl 
     122         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     123      END DO 
     124 
     125      DO jj = 1, jpj 
     126         DO ji = 1, jpi             
     127            ! heat content variation (W.m-2) 
     128            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     129               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     130               &                 ) * r1_rdtice 
     131            ! salt, volume 
     132            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
     133            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice 
     134            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice 
     135         END DO 
     136      END DO 
     137 
    119138      ! conservation test 
    120139      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    121  
    122       ! ------------------------------------------------- 
    123       ! Diagnostics 
    124       ! ------------------------------------------------- 
    125       DO jl  = 1, jpl 
    126          afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
    127       END DO 
    128  
    129       ! heat content variation (W.m-2) 
    130       DO jj = 1, jpj 
    131          DO ji = 1, jpi             
    132             diag_heat_dhc(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
    133                &                       SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
    134                &                     ) * r1_rdtice    
    135          END DO 
    136       END DO 
    137140 
    138141      ! ------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    • Property svn:keywords set to Id
    r5134 r5350  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    43    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     43   !! $Id$ 
    4444   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    … …  
    7272      ! Constrain the thickness of the smallest category above himin 
    7373      !---------------------------------------------------------------------- 
    74       CALL lim_var_glo2eqv 
    7574      DO jj = 1, jpj  
    7675         DO ji = 1, jpi 
     76            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes 
     77            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch 
    7778            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN 
    78                a_i (ji,jj,1) = a_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
     79               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
     80               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
    7981            ENDIF 
    8082         END DO 
    … …  
    9395            DO ji = 1, jpi 
    9496               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    95                   a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     97                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     98                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    9699               ENDIF 
    97100            END DO 
    98101         END DO 
    99102      END DO 
    100  
    101       !---------------------------------------------------- 
    102       ! Rebin categories with thickness out of bounds 
    103       !---------------------------------------------------- 
    104       IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
    105  
    106       !----------------- 
    107       ! zap small values 
    108       !----------------- 
    109       CALL lim_var_zapsmall 
    110103 
    111104      !--------------------- 
    … …  
    117110               DO ji = 1, jpi 
    118111                  zsal            = smv_i(ji,jj,jl) 
    119                   smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    120112                  ! salinity stays in bounds 
    121113                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    … …  
    127119         END DO 
    128120      ENDIF 
     121 
     122      !---------------------------------------------------- 
     123      ! Rebin categories with thickness out of bounds 
     124      !---------------------------------------------------- 
     125      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
     126 
     127      !----------------- 
     128      ! zap small values 
     129      !----------------- 
     130      CALL lim_var_zapsmall 
    129131 
    130132      !------------------------------------------------------------------------------ 
    … …  
    150152      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 
    151153  
    152       ! for outputs 
    153       CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
    154       CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    155  
    156       ! conservation test 
    157       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    158  
    159154      ! ------------------------------------------------- 
    160155      ! Diagnostics 
    161156      ! ------------------------------------------------- 
    162157      DO jl  = 1, jpl 
     158         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging 
    163159         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
    164160      END DO 
    165161      afx_tot = afx_thd + afx_dyn 
    166162 
    167       ! heat content variation (W.m-2) 
    168163      DO jj = 1, jpj 
    169164         DO ji = 1, jpi             
    170             diag_heat_dhc(ji,jj) = diag_heat_dhc(ji,jj) -  & 
    171                &                   ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
    172                &                     SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
    173                &                   ) * r1_rdtice    
    174          END DO 
    175       END DO 
     165            ! heat content variation (W.m-2) 
     166            diag_heat(ji,jj) = diag_heat(ji,jj) -  & 
     167               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     168               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     169               &               ) * r1_rdtice    
     170            ! salt, volume 
     171            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
     172            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice 
     173            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice 
     174         END DO 
     175      END DO 
     176 
     177      ! conservation test 
     178      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     179 
     180      ! for outputs 
     181      CALL lim_var_glo2eqv 
     182      CALL lim_var_agg(2) 
    176183 
    177184      ! ------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r5134 r5350  
    124124               DO ji = 1, jpi 
    125125                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                           ! snow heat content 
    126                   rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
    127                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity 
    128                   rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    129                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age 
     126                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) )  
     127                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch   ! ice salinity 
     128                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) )  
     129                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi20 ) * rswitch   ! ice age 
    130130               END DO 
    131131            END DO 
    … …  
    161161         DO jj = 1, jpj 
    162162            DO ji = 1, jpi 
    163                rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )   !0 if no ice and 1 if yes 
    164                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    165                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    166                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
     163               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes 
     164               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     165               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     166               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    167167            END DO 
    168168         END DO 
    … …  
    173173            DO jj = 1, jpj 
    174174               DO ji = 1, jpi 
    175                   rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) )   !0 if no ice and 1 if yes 
    176                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch 
     175                  rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes 
     176                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch 
     177                  !                                      ! bounding salinity 
     178                  sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin ) 
    177179               END DO 
    178180            END DO 
    … …  
    199201                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 
    200202                  t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
    201                   t_i(ji,jj,jk,jl) = MIN( rt0, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rt0 < t_i < rt0 
     203                  t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) )  ! -100 < t_i < ztmelts 
    202204               END DO 
    203205            END DO 
    … …  
    219221                  ! 
    220222                  t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 ) 
    221                   t_s(ji,jj,jk,jl) = MIN( rt0, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rt0 < t_i < rt0 
     223                  t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) )     ! -100 < t_s < rt0 
    222224               END DO 
    223225            END DO 
    … …  
    228230      ! Mean temperature 
    229231      !------------------- 
     232      vt_i (:,:) = 0._wp 
     233      DO jl = 1, jpl 
     234         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     235      END DO 
     236 
    230237      tm_i(:,:) = 0._wp 
    231238      DO jl = 1, jpl 
    … …  
    234241               DO ji = 1, jpi 
    235242                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
    236                   tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    237                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    238                END DO 
    239             END DO 
    240          END DO 
    241       END DO 
     243                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
     244                     &            / MAX( vt_i(ji,jj) , epsi10 ) 
     245               END DO 
     246            END DO 
     247         END DO 
     248      END DO 
     249      tm_i = tm_i + rt0 
    242250      ! 
    243251   END SUBROUTINE lim_var_glo2eqv 
    … …  
    258266      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    259267      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    260       oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:) 
    261268      ! 
    262269   END SUBROUTINE lim_var_eqv2glo 
    … …  
    305312            DO jj = 1, jpj 
    306313               DO ji = 1, jpi 
    307                   z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 
     314                  rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) ) 
     315                  z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) ) 
    308316               END DO 
    309317            END DO 
    … …  
    339347                     !                                      ! weighting the profile 
    340348                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 
     349                     !                                      ! bounding salinity 
     350                     s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) ) 
    341351                  END DO 
    342352               END DO 
    … …  
    379389 
    380390      ! Mean sea ice temperature 
     391      vt_i (:,:) = 0._wp 
     392      DO jl = 1, jpl 
     393         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     394      END DO 
     395 
    381396      tm_i(:,:) = 0._wp 
    382397      DO jl = 1, jpl 
    … …  
    385400               DO ji = 1, jpi 
    386401                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
    387                   tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    388                      &                      * r1_nlay_i / MAX( vt_i(ji,jj) , epsi10 ) 
    389                END DO 
    390             END DO 
    391          END DO 
    392       END DO 
     402                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
     403                     &            / MAX( vt_i(ji,jj) , epsi10 ) 
     404               END DO 
     405            END DO 
     406         END DO 
     407      END DO 
     408      tm_i = tm_i + rt0 
    393409 
    394410   END SUBROUTINE lim_var_icetm 
    … …  
    409425      !!------------------------------------------------------------------ 
    410426      ! 
     427      vt_i (:,:) = 0._wp 
     428      DO jl = 1, jpl 
     429         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     430      END DO 
     431 
    411432      bv_i(:,:) = 0._wp 
    412433      DO jl = 1, jpl 
    … …  
    417438                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )   & 
    418439                     &                   * v_i(ji,jj,jl) * r1_nlay_i 
    419                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    420                   bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
     440                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) )  ) 
     441                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi20 ) 
    421442               END DO 
    422443            END DO 
    … …  
    460481         ! 
    461482         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    462             z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 
     483            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 
     484            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) ) 
    463485         END DO 
    464486 
    … …  
    484506               ! weighting the profile 
    485507               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
     508               ! bounding salinity 
     509               s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) ) 
    486510            END DO  
    487511         END DO  
    … …  
    537561                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
    538562                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch 
     563                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch 
     564                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  & 
     565                     &                                       / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch 
    539566                  zei              = e_i(ji,jj,jk,jl) 
    540567                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch 
    … …  
    550577               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
    551578               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch 
    552                 
     579               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch 
     580               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  & 
     581                  &                              / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch 
    553582               zsal = smv_i(ji,jj,  jl) 
    554583               zvi  = v_i  (ji,jj,  jl) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r5123 r5350  
    7272      ! Mean category values 
    7373      !----------------------------- 
     74      z1_365 = 1._wp / 365._wp 
    7475 
    7576      CALL lim_var_icetm      ! mean sea ice temperature 
    … …  
    112113         CALL lbc_lnk( z2da, 'T', -1. ) 
    113114         CALL lbc_lnk( z2db, 'T', -1. ) 
    114          CALL iom_put( "uice_ipa"     , z2da                )       ! ice velocity u component 
    115          CALL iom_put( "vice_ipa"     , z2db                )       ! ice velocity v component 
     115         CALL iom_put( "uice_ipa"     , z2da             )       ! ice velocity u component 
     116         CALL iom_put( "vice_ipa"     , z2db             )       ! ice velocity v component 
    116117         DO jj = 1, jpj                                  
    117118            DO ji = 1, jpi 
    … …  
    119120            END DO 
    120121         END DO 
    121          CALL iom_put( "icevel"       , z2d                 )       ! ice velocity module 
     122         CALL iom_put( "icevel"       , z2d              )       ! ice velocity module 
    122123      ENDIF 
    123124      ! 
    … …  
    127128            DO jj = 1, jpj 
    128129               DO ji = 1, jpi 
    129                   z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl) 
     130                  rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
     131                  z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 
    130132               END DO 
    131133            END DO 
    132134         END DO 
    133          z1_365 = 1._wp / 365._wp 
    134          CALL iom_put( "miceage"     , z2d * z1_365         )        ! mean ice age 
     135         CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age 
    135136      ENDIF 
    136137 
    … …  
    141142            END DO 
    142143         END DO 
    143          CALL iom_put( "micet"       , z2d                  )        ! mean ice temperature 
     144         CALL iom_put( "micet"       , z2d               )        ! mean ice temperature 
    144145      ENDIF 
    145146      ! 
    … …  
    153154            END DO 
    154155         END DO 
    155          CALL iom_put( "icest"       , z2d                 )        ! ice surface temperature 
     156         CALL iom_put( "icest"       , z2d              )        ! ice surface temperature 
    156157      ENDIF 
    157158 
    … …  
    163164            END DO 
    164165         END DO 
    165          CALL iom_put( "icecolf"     , z2d                 )        ! frazil ice collection thickness 
     166         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness 
    166167      ENDIF 
    167168 
    … …  
    232233      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !   
    233234      CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base  
    234       CALL iom_put ('hfxdhc'     , diag_heat_dhc(:,:)   )   ! Heat content variation in snow and ice  
     235      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice  
    235236      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip  
    236237       
    … …  
    248249            DO jj = 1, jpj 
    249250               DO ji = 1, jpi 
    250                   rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    251                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch 
     251                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
     252                  rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 
     253                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 
    252254               END DO 
    253255            END DO 
    254256         END DO 
    255          CALL iom_put( "iceage_cat"     , zoi        )        ! ice age for categories 
     257         CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories 
    256258      ENDIF 
    257259 
    … …  
    264266                  DO ji = 1, jpi 
    265267                     rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    266                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
     268                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 
    267269                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 
    268270                        rswitch * r1_nlay_i 
    … …  
    271273            END DO 
    272274         END DO 
    273          CALL iom_put( "brinevol_cat"     , zei         )        ! brine volume for categories 
     275         CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories 
    274276      ENDIF 
    275277 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r5123 r5350  
    2020   !                               !!! ** ice-thermo namelist (namicethd) ** 
    2121   REAL(wp), PUBLIC ::   rn_himin    !: minimum ice thickness 
    22    REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not 
    2322   REAL(wp), PUBLIC ::   rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 
    2423   REAL(wp), PUBLIC ::   rn_vfrazb   !: threshold drift speed for collection of bottom frazil ice 
    … …  
    5554   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d 
    5655   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
    5757 
    5858   ! heat flux associated with ice-atmosphere mass exchange 
    … …  
    139139      !!---------------------------------------------------------------------! 
    140140 
    141       ALLOCATE( npb      (jpij) , nplm        (jpij) , npac     (jpij),   & 
    142          !                                                                  ! 
    143          &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     & 
    144          &      qsr_ice_1d (jpij) ,     & 
    145          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
    146          &      t_bo_1d   (jpij) ,                                          & 
    147          &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     &  
    148          &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 
    149          &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 
    150          &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 
    151          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) ) 
     141      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   & 
     142         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   & 
     143         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   & 
     144         &      t_bo_1d   (jpij) ,                                         & 
     145         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    &  
     146         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      & 
     147         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      & 
     148         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   & 
     149         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) ) 
    152150      ! 
    153       ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     & 
    154          &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     & 
    155          &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , & 
    156          &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  & 
    157          &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
    158          &      tatm_ice_1d(jpij) ,      &    
    159          &      i0         (jpij) ,     &   
    160          &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   & 
    161          &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 
    162          &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
     151      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     & 
     152         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     & 
     153         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  & 
     154         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  & 
     155         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,                     & 
     156         &      tatm_ice_1d(jpij) , i0         (jpij) ,                                         &   
     157         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  & 
     158         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     & 
     159         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &      
    163160         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
    164161      ! 
    165       ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &    
    166          &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
     162      ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &    
     163         &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    167164         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    168          &      dh_snowice(jpij) ,  & 
    169          &      sm_i_1d   (jpij) , s_i_new  (jpij) ,    & 
    170          &      t_s_1d(jpij,nlay_s),                                       & 
    171          &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &             
    172          &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     & 
     165         &      dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    & 
     166         &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &             
     167         &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        & 
    173168         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 
    174169      ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OFF_SRC/domain.F90

    r5347 r5350  
    116116      USE ioipsl 
    117117      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    118       NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,   & 
    119          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock  ,   & 
     118      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     119         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     120         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    120121         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    121122      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   & 
    … …  
    172173      ninist = nn_istate 
    173174      nstock = nn_stock 
     175      nstocklist = nn_stocklist 
    174176      nwrite = nn_write 
    175177 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    • Property svn:keywords set to Id
    r5120 r5350  
    6262   !!---------------------------------------------------------------------- 
    6363   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    64    !! $Id: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $ 
     64   !! $Id$ 
    6565   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6666   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/dtadyn.F90

    • Property svn:keywords set to Id

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/obs_fbm.F90

    • Property svn:keywords set to Id

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90

    • Property svn:keywords set to Id
    r4132 r5350  
    4040   CHARACTER(len=128) :: & 
    4141      & alt_file                       !: altimeter file 
     42   !! $Id$ 
    4243CONTAINS 
    4344   SUBROUTINE ooo_data_init( ld_cl4 ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90

    • Property svn:keywords set to Id
    r4120 r5350  
    1616   PUBLIC ooo_interp 
    1717 
     18   !! $Id$ 
    1819   CONTAINS 
    1920 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90

    • Property svn:keywords set to Id
    r4117 r5350  
    2222   PUBLIC ooo_rea_dri 
    2323 
     24   !! $Id$ 
    2425CONTAINS 
    2526   SUBROUTINE ooo_rea_dri(kfile) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90

    • Property svn:keywords set to Id
    r4111 r5350  
    1010   REAL(kind=dp), PARAMETER :: obfilldbl=99999. 
    1111 
     12   !! $Id$ 
    1213   CONTAINS 
    1314 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90

    • Property svn:keywords set to Id
    r4110 r5350  
    2929   END INTERFACE 
    3030 
     31   !! $Id$ 
    3132   CONTAINS 
    3233 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    5757   !!---------------------------------------------------------------------- 
    5858   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    59    !! $Id: $ 
     59   !! $Id$ 
    6060   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6161   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    • Property svn:keywords set to Id
    r4999 r5350  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    38    !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $  
     38   !! $Id$  
    3939   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    • Property svn:keywords set to Id
    r4354 r5350  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    35    !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $  
     35   !! $Id$  
    3636   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    • Property svn:keywords set to Id
    r5123 r5350  
    2828   USE ice             ! LIM_3 ice variables 
    2929   USE dom_ice         ! sea-ice domain 
     30   USE limvar 
    3031#endif  
    3132   USE par_oce         ! ocean parameters 
    … …  
    4142   PRIVATE 
    4243 
    43    PUBLIC   bdy_ice_lim    ! routine called in sbcmod 
     44   PUBLIC   bdy_ice_lim     ! routine called in sbcmod 
    4445   PUBLIC   bdy_ice_lim_dyn ! routine called in limrhg 
    4546 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    48    !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $ 
     49   !! $Id$ 
    4950   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5051   !!---------------------------------------------------------------------- 
    … …  
    6162      INTEGER               :: ib_bdy ! Loop index 
    6263 
     64#if defined key_lim3 
     65      CALL lim_var_glo2eqv 
     66#endif 
     67 
    6368      DO ib_bdy=1, nb_bdy 
    6469 
    … …  
    7378 
    7479      END DO 
     80 
     81#if defined key_lim3 
     82      CALL lim_var_zapsmall 
     83      CALL lim_var_agg(1) 
     84#endif 
    7585 
    7686   END SUBROUTINE bdy_ice_lim 
    … …  
    8999      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    90100      INTEGER,         INTENT(in) ::   kt   ! main time-step counter 
    91       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index      !! 
     101      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    92102 
    93103      INTEGER  ::   jpbound            ! 0 = incoming ice 
    … …  
    169179            jpbound = 0; ii = ji; ij = jj; 
    170180 
    171             IF ( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    172             IF ( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    173             IF ( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    174             IF ( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    175  
    176             rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ii,ij) + 0.01 ) ) ! 0 if no ice 
     181            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
     182            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
     183            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
     184            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
     185 
     186            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
     187                                                                              !      do not make state variables dependent on velocity 
     188                
     189 
     190            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 
    177191 
    178192            ! concentration and thickness 
    … …  
    190204 
    191205               ! Ice salinity, age, temperature 
    192                sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * s_i_min 
    193                o_i(ji,jj,jl)    = rswitch * rn_ice_age(ib_bdy)  + ( 1.0 - rswitch ) 
     206               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin 
     207               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl) 
    194208               t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy) 
    195209               DO jk = 1, nlay_s 
    … …  
    198212               DO jk = 1, nlay_i 
    199213                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0  
    200                   s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min 
     214                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 
    201215               END DO 
    202216                
    … …  
    204218  
    205219               ! Ice salinity, age, temperature 
    206                sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * s_i_min 
    207                o_i(ji,jj,jl)    = rswitch * o_i(ii,ij,jl)   + ( 1.0 - rswitch ) 
     220               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin 
     221               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl) 
    208222               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0 
    209223               DO jk = 1, nlay_s 
    … …  
    212226               DO jk = 1, nlay_i 
    213227                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 
    214                   s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * s_i_min 
     228                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 
    215229               END DO 
    216230 
    … …  
    218232 
    219233            ! if salinity is constant, then overwrite rn_ice_sal 
    220             IF( num_sal == 1 ) THEN 
    221                sm_i(ji,jj,jl)   = bulk_sal 
    222                s_i (ji,jj,:,jl) = bulk_sal 
     234            IF( nn_icesal == 1 ) THEN 
     235               sm_i(ji,jj,jl)   = rn_icesal 
     236               s_i (ji,jj,:,jl) = rn_icesal 
    223237            ENDIF 
    224238 
    225239            ! contents 
    226240            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    227             oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    228241            DO jk = 1, nlay_s 
    229242               ! Snow energy of melting 
    … …  
    254267         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy ) 
    255268         CALL lbc_bdy_lnk(  oa_i(:,:,jl), 'T', 1., ib_bdy ) 
    256          CALL lbc_bdy_lnk(   o_i(:,:,jl), 'T', 1., ib_bdy ) 
    257269         CALL lbc_bdy_lnk(  t_su(:,:,jl), 'T', 1., ib_bdy ) 
    258270         DO jk = 1, nlay_s 
    … …  
    286298      !! 
    287299      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
    288       INTEGER  ::   jb, jgrd   ! dummy loop indices 
     300      INTEGER  ::   jb, jgrd           ! dummy loop indices 
    289301      INTEGER  ::   ji, jj             ! local scalar 
    290       INTEGER  ::   ib_bdy ! Loop index 
     302      INTEGER  ::   ib_bdy             ! Loop index 
    291303      REAL(wp) ::   zmsk1, zmsk2, zflag 
    292304     !!------------------------------------------------------------------------------ 
    … …  
    304316         CASE('frs') 
    305317             
    306  
     318            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
     319                                                               !      do not change ice velocity (it is only computed by rheology) 
     320  
    307321            SELECT CASE ( cd_type ) 
    308  
     322                
    309323            CASE ( 'U' ) 
    310324                
    … …  
    321335                      
    322336                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    323                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + & 
    324                         &            u_ice(ji-1,jj) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + & 
     337                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
     338                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    325339                        &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    326340                  ELSE                             ! everywhere else 
    … …  
    329343                  ENDIF 
    330344                  ! mask ice velocities 
    331                   rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice 
     345                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 
    332346                  u_ice(ji,jj) = rswitch * u_ice(ji,jj) 
    333347                   
    334348               ENDDO 
    335  
     349                
    336350               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
    337351                
    … …  
    350364                      
    351365                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    352                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + & 
    353                         &            v_ice(ji,jj-1) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + & 
     366                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
     367                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    354368                        &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    355369                  ELSE                             ! everywhere else 
    … …  
    358372                  ENDIF 
    359373                  ! mask ice velocities 
    360                   rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice 
     374                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 
    361375                  v_ice(ji,jj) = rswitch * v_ice(ji,jj) 
    362376                   
    … …  
    364378                
    365379               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
    366                 
     380                   
    367381            END SELECT 
    368382             

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    31    !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $  
     31   !! $Id$  
    3232   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90

    • Property svn:keywords set to Id
    r4667 r5350  
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
    33    !! $Id: c1d.F90 2382 2010-11-13 13:08:12Z gm $  
     33   !! $Id$  
    3434   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3535   !!====================================================================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    • Property svn:keywords set to Id
    r4667 r5350  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    28    !! $Id: domc1d.F90 3851 2013-04-30 10:30:51Z hadcv $  
     28   !! $Id$  
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    37    !! $Id: dtauvd.F90 2392 2010-11-15 21:20:05Z gm $  
     37   !! $Id$  
    3838   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90

    • Property svn:keywords set to Id
    r2409 r5350  
    3030   !!---------------------------------------------------------------------- 
    3131   !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
    32    !! $Id: dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm $  
     32   !! $Id$  
    3333   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    • Property svn:keywords set to Id
    r5102 r5350  
    4747   !!---------------------------------------------------------------------- 
    4848   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    49    !! $Id: dyndmp.F90 3294 2012-01-28 16:44:18Z rblod $  
     49   !! $Id$  
    5050   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90

    • Property svn:keywords set to Id
    r2409 r5350  
    2525   !!---------------------------------------------------------------------- 
    2626   !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
    27    !! $Id: dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm $  
     27   !! $Id$  
    2828   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2929   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    • Property svn:keywords set to Id
    r5108 r5350  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/C1D 3.3 , NEMO Consortium (2010) 
    34    !! $Id: step_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    • Property svn:keywords set to Id
    r4064 r5350  
    164164 
    165165 
     166   !! $Id$ 
    166167CONTAINS 
    167168    

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    • Property svn:keywords set to Id
    r4314 r5350  
    5757#  include "domzgr_substitute.h90" 
    5858    
     59   !! $Id$ 
    5960CONTAINS 
    6061 
    … …  
    18821883      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
    18831884 
    1884       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     1885      CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf ) 
    18851886 
    18861887   END SUBROUTINE crs_dom_sfc 
    … …  
    22742275      ENDDO 
    22752276      
    2276       CALL wrk_alloc( jpi_crs, jpj_crs, zmbk ) 
    2277  
    22782277      zmbk(:,:) = 0.0 
    22792278      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    • Property svn:keywords set to Id
    r4294 r5350  
    3333   PUBLIC crs_dom_wri        ! routine called by crsini.F90 
    3434 
     35   !! $Id$ 
    3536CONTAINS 
    3637 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    • Property svn:keywords set to Id
    r4149 r5350  
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    40    !! $Id $ 
     40   !! $Id$ 
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    2929#  include "domzgr_substitute.h90" 
    3030 
     31   !! $Id$ 
    3132CONTAINS 
    3233    

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    • Property svn:keywords set to Id
    r4015 r5350  
    2222   PUBLIC crs_lbc_lnk 
    2323    
     24   !! $Id$ 
    2425CONTAINS 
    2526 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r5121 r5350  
    2121   USE timing         ! preformance summary 
    2222   USE wrk_nemo       ! working arrays 
     23   USE fldread        ! type FLD_N 
     24   USE phycst         ! physical constant 
     25   USE in_out_manager  ! I/O manager 
    2326 
    2427   IMPLICIT NONE 
    … …  
    208211      REAL(wp) ::   zztmp   
    209212      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
     213      ! reading initial file 
     214      LOGICAL  ::   ln_tsd_init      !: T & S data flag 
     215      LOGICAL  ::   ln_tsd_tradmp    !: internal damping toward input data flag 
     216      CHARACTER(len=100)            ::   cn_dir 
     217      TYPE(FLD_N)                   ::  sn_tem,sn_sal 
     218      INTEGER  ::   ios=0 
     219 
     220      NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal 
     221      ! 
     222 
     223      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist : 
     224      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
     225901   IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp ) 
     226      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run 
     227      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
     228902   IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp ) 
     229      IF(lwm) WRITE ( numond, namtsd ) 
     230      ! 
    210231      !!---------------------------------------------------------------------- 
    211232      ! 
    … …  
    227248      END DO 
    228249      IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    229        
    230       CALL iom_open ( 'data_1m_salinity_nomask', inum ) 
    231       CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1  ) 
    232       CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 ) 
     250 
     251      CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum ) 
     252      CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1  ) 
     253      CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 
    233254      CALL iom_close( inum ) 
    234255      sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    4242#endif 
    4343#if defined key_lim3 
    44   USE par_ice 
    4544  USE ice 
    4645#endif 
    … …  
    113112  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d   
    114113 
     114   !! $Id$ 
    115115CONTAINS 
    116116 
    … …  
    12981298   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .FALSE.    !: diamht flag 
    12991299   PUBLIC  
     1300   !! $Id$ 
    13001301CONTAINS 
    13011302 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    6060   !!---------------------------------------------------------------------- 
    6161   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    62    !! $Id:$ 
     62   !! $Id$ 
    6363   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6464   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r4990 r5350  
    88   !!            3.2  ! 2010-03  (O. Marti, S. Flavoni) Add fields 
    99   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation 
     10   !!            3.6  ! 2014-12  (C. Ethe) use of IOM 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    1314   !!   dia_ptr      : Poleward Transport Diagnostics module 
    1415   !!   dia_ptr_init : Initialization, namelist read 
    15    !!   dia_ptr_wri  : Output of poleward fluxes 
    16    !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array 
    17    !!   ptr_tjk      : "zonal" mean computation of a tracer field 
    18    !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array 
    19    !!                   (Generic interface to ptr_vj_3d, ptr_vj_2d) 
     16   !!   ptr_sjk      : "zonal" mean computation of a field - tracer or flux array 
     17   !!   ptr_sj       : "zonal" and vertical sum computation of a "meridional" flux array 
     18   !!                   (Generic interface to ptr_sj_3d, ptr_sj_2d) 
    2019   !!---------------------------------------------------------------------- 
    2120   USE oce              ! ocean dynamics and active tracers 
    2221   USE dom_oce          ! ocean space and time domain 
    2322   USE phycst           ! physical constants 
    24    USE ldftra_oce       ! ocean active tracers: lateral physics 
    25    USE dianam           ! 
     23   ! 
    2624   USE iom              ! IOM library 
    27    USE ioipsl           ! IO-IPSL library 
    2825   USE in_out_manager   ! I/O manager 
    2926   USE lib_mpp          ! MPP library 
    30    USE lbclnk           ! lateral boundary condition - processor exchanges 
    3127   USE timing           ! preformance summary 
    32    USE wrk_nemo         ! working arrays 
    3328 
    3429   IMPLICIT NONE 
    3530   PRIVATE 
    3631 
    37    INTERFACE ptr_vj 
    38       MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d 
     32   INTERFACE ptr_sj 
     33      MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 
    3934   END INTERFACE 
    4035 
    41    PUBLIC   dia_ptr_init   ! call in opa module 
     36   PUBLIC   ptr_sj         ! call by tra_ldf & tra_adv routines 
     37   PUBLIC   ptr_sjk        !  
     38   PUBLIC   dia_ptr_init   ! call in step module 
    4239   PUBLIC   dia_ptr        ! call in step module 
    43    PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines 
    44    PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines 
    4540 
    4641   !                                  !!** namelist  namptr  ** 
    47    LOGICAL , PUBLIC ::   ln_diaptr     !: Poleward transport flag (T) or not (F) 
    48    LOGICAL , PUBLIC ::   ln_subbas     !: Atlantic/Pacific/Indian basins calculation 
    49    LOGICAL , PUBLIC ::   ln_diaznl     !: Add zonal means and meridional stream functions 
    50    LOGICAL , PUBLIC ::   ln_ptrcomp    !: Add decomposition : overturning (and gyre, soon ...) 
    51    INTEGER , PUBLIC ::   nn_fptr       !: frequency of ptr computation  [time step] 
    52    INTEGER , PUBLIC ::   nn_fwri       !: frequency of ptr outputs      [time step] 
    53  
    54    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf, htr_ove   !: Heat TRansports (adv, diff, overturn.) 
    55    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf, str_ove   !: Salt TRansports (adv, diff, overturn.) 
     42   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.) 
     43   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.) 
    5644    
    57    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   btmsk                  ! T-point basin interior masks 
    58    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   btm30                  ! mask out Southern Ocean (=0 south of 30°S) 
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr  , str             ! adv heat and salt transports (approx) 
    60    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_jk, sn_jk , v_msf   ! i-mean T and S, j-Stream-Function 
    61    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sjk  , r1_sjk          ! i-mean i-k-surface and its inverse         
    62    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr_eiv, str_eiv       ! bolus adv heat ans salt transports ('key_diaeiv') 
    63    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_msf_eiv              ! bolus j-streamfuction              ('key_diaeiv') 
    64  
    65  
    66    INTEGER ::   niter       ! 
    67    INTEGER ::   nidom_ptr   ! 
    68    INTEGER ::   numptr      ! logical unit for Poleward TRansports 
    69    INTEGER ::   nptr        ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T)  
     45 
     46   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
     47   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation 
     48   INTEGER         ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
    7049 
    7150   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
    … …  
    7352   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg 
    7453 
    75    REAL(wp), TARGET, DIMENSION(:),   ALLOCATABLE, SAVE :: p_fval1d 
    76    REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d 
    77  
    78    !! Integer, 1D workspace arrays. Not common enough to be implemented in  
    79    !! wrk_nemo module. 
    80    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc 
    81    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30 
    82    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 
     54   CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:)     :: clsubb 
     55   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks 
     56   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   :: btm30   ! mask out Southern Ocean (=0 south of 30°S) 
     57 
     58   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)     :: p_fval1d 
     59   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d 
     60 
    8361 
    8462   !! * Substitutions 
    … …  
    9270CONTAINS 
    9371 
    94    FUNCTION dia_ptr_alloc() 
    95       !!---------------------------------------------------------------------- 
    96       !!                    ***  ROUTINE dia_ptr_alloc  *** 
    97       !!---------------------------------------------------------------------- 
    98       INTEGER               ::   dia_ptr_alloc   ! return value 
    99       INTEGER, DIMENSION(6) ::   ierr 
    100       !!---------------------------------------------------------------------- 
    101       ierr(:) = 0 
    102       ! 
    103       ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    104          &      htr_adv(jpj) , str_adv(jpj) ,   & 
    105          &      htr_ldf(jpj) , str_ldf(jpj) ,   & 
    106          &      htr_ove(jpj) , str_ove(jpj),    & 
    107          &      htr(jpj,nptr) , str(jpj,nptr) , & 
    108          &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 
    109          &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  ) 
    110          ! 
    111 #if defined key_diaeiv 
    112       ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 
    113          &      v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 
    114 #endif 
    115       ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 
    116       ! 
    117       ALLOCATE(ndex(jpj*jpk),        ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 
    118          &     ndex_ind(jpj*jpk),    ndex_ipc(jpj*jpk),                    & 
    119          &     ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 
    120  
    121       ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk),                   & 
    122          &     ndex_h(jpj),          ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 
    123          &     ndex_h_ind_30(jpj),   ndex_h_ipc_30(jpj), Stat=ierr(5) ) 
    124          ! 
    125      ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6)  ) 
    126          ! 
    127       dia_ptr_alloc = MAXVAL( ierr ) 
    128       IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc ) 
    129       ! 
    130    END FUNCTION dia_ptr_alloc 
    131  
    132  
    133    FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval ) 
    134       !!---------------------------------------------------------------------- 
    135       !!                    ***  ROUTINE ptr_vj_3d  *** 
    136       !! 
    137       !! ** Purpose :   i-k sum computation of a j-flux array 
    138       !! 
    139       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    140       !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    141       !! 
    142       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    143       !!---------------------------------------------------------------------- 
    144       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
    145       !! 
    146       INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
    147       INTEGER                  ::   ijpj         ! ??? 
    148       REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
    149       !!-------------------------------------------------------------------- 
    150       ! 
    151       p_fval => p_fval1d 
    152  
    153       ijpj = jpj 
    154       p_fval(:) = 0._wp 
    155       DO jk = 1, jpkm1 
    156          DO jj = 2, jpjm1 
    157             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    158                p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)  
    159             END DO 
    160          END DO 
    161       END DO 
    162 #if defined key_mpp_mpi 
    163       IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl) 
    164 #endif 
    165       ! 
    166    END FUNCTION ptr_vj_3d 
    167  
    168  
    169    FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval ) 
    170       !!---------------------------------------------------------------------- 
    171       !!                    ***  ROUTINE ptr_vj_2d  *** 
    172       !! 
    173       !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
    174       !! 
    175       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    176       !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    177       !! 
    178       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    179       !!---------------------------------------------------------------------- 
    180       IMPLICIT none 
    181       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point 
    182       !! 
    183       INTEGER                  ::   ji,jj       ! dummy loop arguments 
    184       INTEGER                  ::   ijpj        ! ??? 
    185       REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
    186       !!-------------------------------------------------------------------- 
    187       !  
    188       p_fval => p_fval1d 
    189  
    190       ijpj = jpj 
    191       p_fval(:) = 0._wp 
    192       DO jj = 2, jpjm1 
    193          DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    194             p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 
    195          END DO 
    196       END DO 
    197 #if defined key_mpp_mpi 
    198       CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 
    199 #endif 
    200       !  
    201    END FUNCTION ptr_vj_2d 
    202  
    203  
    204    FUNCTION ptr_vjk( pva, pmsk )   RESULT ( p_fval ) 
    205       !!---------------------------------------------------------------------- 
    206       !!                    ***  ROUTINE ptr_vjk  *** 
    207       !! 
    208       !! ** Purpose :   i-sum computation of a j-velocity array 
    209       !! 
    210       !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
    211       !!              pva is supposed to be a masked flux (i.e. * vmask) 
    212       !! 
    213       !! ** Action  : - p_fval: i-mean poleward flux of pva 
    214       !!---------------------------------------------------------------------- 
    215       !! 
    216       IMPLICIT none 
    217       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point 
    218       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    219       !! 
    220       INTEGER                           :: ji, jj, jk ! dummy loop arguments 
    221       REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    222 #if defined key_mpp_mpi 
    223       INTEGER, DIMENSION(1) ::   ish 
    224       INTEGER, DIMENSION(2) ::   ish2 
    225       INTEGER               ::   ijpjjpk 
    226 #endif 
    227 #if defined key_mpp_mpi 
    228       REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point 
    229 #endif 
    230       !!-------------------------------------------------------------------- 
    231       ! 
    232 #if defined key_mpp_mpi 
    233       ijpjjpk = jpj*jpk 
    234       CALL wrk_alloc( jpj*jpk, zwork ) 
    235 #endif 
    236  
    237       p_fval => p_fval2d 
    238  
    239       p_fval(:,:) = 0._wp 
    240       ! 
    241       IF( PRESENT( pmsk ) ) THEN  
    242          DO jk = 1, jpkm1 
    243             DO jj = 2, jpjm1 
    244 !!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
    245                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    246                   p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj) 
     72   SUBROUTINE dia_ptr( pvtr ) 
     73      !!---------------------------------------------------------------------- 
     74      !!                  ***  ROUTINE dia_ptr  *** 
     75      !!---------------------------------------------------------------------- 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
     77      ! 
     78      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     79      REAL(wp) ::   zv, zsfc               ! local scalar 
     80      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
     84      CHARACTER( len = 10 )  :: cl1 
     85      !!---------------------------------------------------------------------- 
     86      ! 
     87      IF( nn_timing == 1 )   CALL timing_start('dia_ptr') 
     88 
     89      ! 
     90      IF( PRESENT( pvtr ) ) THEN 
     91         IF( iom_use("zomsfglo") ) THEN    ! effective MSF 
     92            z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) )  ! zonal cumulative effective transport 
     93            DO jk = 2, jpkm1  
     94              z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)   ! effective j-Stream-Function (MSF) 
     95            END DO 
     96            DO ji = 1, jpi 
     97               z3d(ji,:,:) = z3d(1,:,:) 
     98            ENDDO 
     99            cl1 = TRIM('zomsf'//clsubb(1) ) 
     100            CALL iom_put( cl1, z3d * rc_sv ) 
     101            DO jn = 2, nptr                                    ! by sub-basins 
     102               z3d(1,:,:) =  ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) )  
     103               DO jk = 2, jpkm1  
     104                  z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)    ! effective j-Stream-Function (MSF) 
    247105               END DO 
    248             END DO 
    249          END DO 
    250       ELSE  
    251          DO jk = 1, jpkm1 
    252             DO jj = 2, jpjm1 
    253                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    254                   p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj) 
    255                END DO 
    256             END DO 
    257          END DO 
    258       END IF 
    259       ! 
    260 #if defined key_mpp_mpi 
    261       ijpjjpk = jpj*jpk 
    262       ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    263       zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
    264       CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
    265       p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    266 #endif 
    267       ! 
    268 #if defined key_mpp_mpi 
    269       CALL wrk_dealloc( jpj*jpk, zwork ) 
    270 #endif 
    271       ! 
    272    END FUNCTION ptr_vjk 
    273  
    274  
    275    FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval ) 
    276       !!---------------------------------------------------------------------- 
    277       !!                    ***  ROUTINE ptr_tjk  *** 
    278       !! 
    279       !! ** Purpose :   i-sum computation of e1t*e3t * a tracer field 
    280       !! 
    281       !! ** Method  : - i-sum of mj(pta) using tmask 
    282       !! 
    283       !! ** Action  : - p_fval: i-sum of e1t*e3t*pta 
    284       !!---------------------------------------------------------------------- 
    285       !! 
    286       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point 
    287       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask 
    288       !! 
    289       INTEGER                           :: ji, jj, jk   ! dummy loop arguments 
    290       REAL(wp), POINTER, DIMENSION(:,:) :: p_fval       ! return function value 
    291 #if defined key_mpp_mpi 
    292       INTEGER, DIMENSION(1) ::   ish 
    293       INTEGER, DIMENSION(2) ::   ish2 
    294       INTEGER               ::   ijpjjpk 
    295 #endif 
    296 #if defined key_mpp_mpi 
    297       REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point 
    298 #endif 
    299       !!--------------------------------------------------------------------  
    300       ! 
    301 #if defined key_mpp_mpi 
    302       ijpjjpk = jpj*jpk 
    303       CALL wrk_alloc( jpj*jpk, zwork ) 
    304 #endif 
    305  
    306       p_fval => p_fval2d 
    307  
    308       p_fval(:,:) = 0._wp 
    309       DO jk = 1, jpkm1 
    310          DO jj = 2, jpjm1 
    311             DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    312                p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj) 
    313             END DO 
    314          END DO 
    315       END DO 
    316 #if defined key_mpp_mpi 
    317       ijpjjpk = jpj*jpk 
    318       ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    319       zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) 
    320       CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
    321       p_fval(:,:)= RESHAPE( zwork, ish2 ) 
    322 #endif 
    323       ! 
    324 #if defined key_mpp_mpi 
    325       CALL wrk_dealloc( jpj*jpk, zwork ) 
    326 #endif 
    327       !     
    328    END FUNCTION ptr_tjk 
    329  
    330  
    331    SUBROUTINE dia_ptr( kt ) 
    332       !!---------------------------------------------------------------------- 
    333       !!                  ***  ROUTINE dia_ptr  *** 
    334       !!---------------------------------------------------------------------- 
    335       USE oce,     vt  =>   ua   ! use ua as workspace 
    336       USE oce,     vs  =>   va   ! use va as workspace 
    337       IMPLICIT none 
    338       !! 
    339       INTEGER, INTENT(in) ::   kt   ! ocean time step index 
    340       ! 
    341       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    342       REAL(wp) ::   zv               ! local scalar 
    343       !!---------------------------------------------------------------------- 
    344       ! 
    345       IF( nn_timing == 1 )   CALL timing_start('dia_ptr') 
    346       ! 
    347       IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 )   THEN 
    348          ! 
    349          IF( MOD( kt, nn_fptr ) == 0 ) THEN  
    350             ! 
    351             IF( ln_diaznl ) THEN               ! i-mean temperature and salinity 
    352                DO jn = 1, nptr 
    353                   tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    354                   sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    355                END DO 
    356             ENDIF 
    357             ! 
    358             !                          ! horizontal integral and vertical dz  
    359             !                                ! eulerian velocity 
    360             v_msf(:,:,1) = ptr_vjk( vn(:,:,:) )  
    361             DO jn = 2, nptr 
    362                v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) )  
    363             END DO 
    364 #if defined key_diaeiv 
    365             DO jn = 1, nptr                  ! bolus velocity 
    366                v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv 
    367             END DO 
    368             !                                ! add bolus stream-function to the eulerian one 
    369             v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 
    370 #endif 
    371             ! 
    372             !                          ! Transports 
    373             !                                ! local heat & salt transports at T-points  ( tsn*mj[vn+v_eiv] ) 
    374             vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp 
    375             DO jk= 1, jpkm1 
    376                DO jj = 2, jpj 
     106               DO ji = 1, jpi 
     107                  z3d(ji,:,:) = z3d(1,:,:) 
     108               ENDDO 
     109               cl1 = TRIM('zomsf'//clsubb(jn) ) 
     110               CALL iom_put( cl1, z3d * rc_sv ) 
     111            END DO 
     112         ENDIF 
     113         ! 
     114      ELSE 
     115         ! 
     116         IF( iom_use("zotemglo") ) THEN    ! i-mean i-k-surface  
     117            DO jk = 1, jpkm1 
     118               DO jj = 1, jpj 
    377119                  DO ji = 1, jpi 
    378 #if defined key_diaeiv  
    379                      zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 
    380 #else 
    381                      zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
    382 #endif  
    383                      vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 
    384                      vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 
    385                   END DO 
    386                END DO 
    387             END DO 
    388 !!gm useless as overlap areas are not used in ptr_vjk 
    389             CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. ) 
    390 !!gm 
    391             !                                ! heat & salt advective transports (approximation) 
    392             htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt   ! SUM over jk + conversion 
    393             str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram 
    394             DO jn = 2, nptr  
    395                htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt   ! mask Southern Ocean 
    396                str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram   ! mask Southern Ocean 
    397             END DO 
    398  
    399             IF( ln_ptrcomp ) THEN            ! overturning transport 
    400                htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt   ! SUM over jk + conversion 
    401                str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram 
    402             END IF 
    403             !                                ! Advective and diffusive transport 
    404             htr_adv(:) = htr_adv(:) * rc_pwatt        ! these are computed in tra_adv... and tra_ldf... routines  
    405             htr_ldf(:) = htr_ldf(:) * rc_pwatt        ! here just the conversion in PW and Gg 
    406             str_adv(:) = str_adv(:) * rc_ggram 
    407             str_ldf(:) = str_ldf(:) * rc_ggram 
    408  
    409 #if defined key_diaeiv 
    410             DO jn = 1, nptr                  ! Bolus component 
    411                htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk 
    412                str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk 
    413             END DO 
    414 #endif 
    415             !                                ! "Meridional" Stream-Function 
     120                     zsfc = e1t(ji,jj) * fse3t(ji,jj,jk) 
     121                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
     122                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 
     123                     zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 
     124                  ENDDO 
     125               ENDDO 
     126            ENDDO 
    416127            DO jn = 1, nptr 
    417                DO jk = 2, jpk  
    418                   v_msf    (:,jk,jn) = v_msf    (:,jk-1,jn) + v_msf    (:,jk,jn)       ! Eulerian j-Stream-Function 
    419 #if defined key_diaeiv 
    420                   v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function 
    421  
    422 #endif 
    423                END DO 
    424             END DO 
    425             v_msf    (:,:,:) = v_msf    (:,:,:) * rc_sv       ! converte in Sverdrups 
    426 #if defined key_diaeiv 
    427             v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 
    428 #endif 
    429          ENDIF 
    430          ! 
    431          CALL dia_ptr_wri( kt )                        ! outputs 
     128               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     129               cl1 = TRIM('zosrf'//clsubb(jn) ) 
     130               CALL iom_put( cl1, zmask ) 
     131               ! 
     132               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
     133                  &            / MAX( zmask(1,:,:), 10.e-15 ) 
     134               DO ji = 1, jpi 
     135                  z3d(ji,:,:) = z3d(1,:,:) 
     136               ENDDO 
     137               cl1 = TRIM('zotem'//clsubb(jn) ) 
     138               CALL iom_put( cl1, z3d ) 
     139               ! 
     140               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
     141                  &            / MAX( zmask(1,:,:), 10.e-15 ) 
     142               DO ji = 1, jpi 
     143                  z3d(ji,:,:) = z3d(1,:,:) 
     144               ENDDO 
     145               cl1 = TRIM('zosal'//clsubb(jn) ) 
     146               CALL iom_put( cl1, z3d ) 
     147            END DO 
     148         ENDIF 
     149         ! 
     150         !                                ! Advective and diffusive heat and salt transport 
     151         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN    
     152            z2d(1,:) = htr_adv(:) * rc_pwatt        !  (conversion in PW) 
     153            DO ji = 1, jpi 
     154               z2d(ji,:) = z2d(1,:) 
     155            ENDDO 
     156            cl1 = 'sophtadv'                  
     157            CALL iom_put( TRIM(cl1), z2d ) 
     158            z2d(1,:) = str_adv(:) * rc_ggram        ! (conversion in Gg) 
     159            DO ji = 1, jpi 
     160               z2d(ji,:) = z2d(1,:) 
     161            ENDDO 
     162            cl1 = 'sopstadv' 
     163            CALL iom_put( TRIM(cl1), z2d ) 
     164         ENDIF 
     165         ! 
     166         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN    
     167            z2d(1,:) = htr_ldf(:) * rc_pwatt        !  (conversion in PW)  
     168            DO ji = 1, jpi 
     169               z2d(ji,:) = z2d(1,:) 
     170            ENDDO 
     171            cl1 = 'sophtldf' 
     172            CALL iom_put( TRIM(cl1), z2d ) 
     173            z2d(1,:) = str_ldf(:) * rc_ggram        !  (conversion in Gg) 
     174            DO ji = 1, jpi 
     175               z2d(ji,:) = z2d(1,:) 
     176            ENDDO 
     177            cl1 = 'sopstldf' 
     178            CALL iom_put( TRIM(cl1), z2d ) 
     179         ENDIF 
    432180         ! 
    433181      ENDIF 
    434       ! 
    435 #if defined key_mpp_mpi 
    436       IF( kt == nitend .AND. l_znl_root )   CALL histclo( numptr )      ! Close the file 
    437 #else 
    438       IF( kt == nitend )                    CALL histclo( numptr )      ! Close the file 
    439 #endif 
    440182      ! 
    441183      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr') 
    … …  
    450192      !! ** Purpose :   Initialization, namelist read 
    451193      !!---------------------------------------------------------------------- 
    452       INTEGER ::   jn           ! dummy loop indices  
    453       INTEGER ::   inum, ierr   ! local integers 
    454       INTEGER ::   ios          ! Local integer output status for namelist read 
    455 #if defined key_mpp_mpi 
    456       INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    457 #endif 
    458       !! 
    459       NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 
     194      INTEGER ::  jn           ! local integers 
     195      INTEGER ::  inum, ierr   ! local integers 
     196      INTEGER ::  ios          ! Local integer output status for namelist read 
     197      !! 
     198      NAMELIST/namptr/ ln_diaptr, ln_subbas 
    460199      !!---------------------------------------------------------------------- 
    461200 
    … …  
    475214         WRITE(numout,*) '   Namelist namptr : set ptr parameters' 
    476215         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr 
    477          WRITE(numout,*) '      Overturning heat & salt transport                  ln_ptrcomp = ', ln_ptrcomp 
    478          WRITE(numout,*) '      T & S zonal mean and meridional stream function    ln_diaznl  = ', ln_diaznl  
    479216         WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas 
    480          WRITE(numout,*) '      Frequency of computation                           nn_fptr    = ', nn_fptr 
    481          WRITE(numout,*) '      Frequency of outputs                               nn_fwri    = ', nn_fwri 
    482217      ENDIF 
    483        
    484       IF( ln_diaptr) THEN   
    485       
    486          IF( nn_timing == 1 )   CALL timing_start('dia_ptr_init') 
    487        
    488          IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
    489          ELSE                   ;   nptr = 1       ! Global only 
     218 
     219      IF( ln_diaptr ) THEN   
     220         ! 
     221         IF( ln_subbas ) THEN  
     222            nptr = 5            ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
     223            ALLOCATE( clsubb(nptr) ) 
     224            clsubb(1) = 'glo' ;  clsubb(2) = 'atl'  ;  clsubb(3) = 'pac'  ;  clsubb(4) = 'ind'  ;  clsubb(5) = 'ipc' 
     225         ELSE                
     226            nptr = 1       ! Global only 
     227            ALLOCATE( clsubb(nptr) ) 
     228            clsubb(1) = 'glo'  
    490229         ENDIF 
    491230 
    … …  
    493232         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    494233 
    495          rc_pwatt = rc_pwatt * rau0 * rcp          ! conversion from K.s-1 to PetaWatt 
     234         rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt 
    496235 
    497236         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    498237 
    499238         IF( ln_subbas ) THEN                ! load sub-basin mask 
    500             CALL iom_open( 'subbasins', inum ) 
     239            CALL iom_open( 'subbasins', inum,  ldstop = .FALSE. ) 
    501240            CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
    502241            CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
    … …  
    508247            END WHERE 
    509248         ENDIF 
     249    
    510250         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean 
    511251       
    … …  
    513253            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only 
    514254         END DO 
    515        
    516          IF( lk_vvl )   CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 
    517  
    518          !                                   ! i-sum of e1v*e3v surface and its inverse 
    519          DO jn = 1, nptr 
    520             sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 
    521             r1_sjk(:,:,jn) = 0._wp 
    522             WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
    523          END DO 
    524  
    525       ! Initialise arrays to zero because diatpr is called before they are first calculated 
    526       ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    527       htr_adv(:) = 0._wp ; str_adv(:) =  0._wp ;  htr_ldf(:) = 0._wp ; str_ldf(:) =  0._wp 
    528  
    529 #if defined key_mpp_mpi  
    530          iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi') 
    531          iloc (1) = nlcj 
    532          iabsf(1) = njmppt(narea) 
    533          iabsl(:) = iabsf(:) + iloc(:) - 1 
    534          ihals(1) = nldj - 1 
    535          ihale(1) = nlcj - nlej 
    536          idid (1) = 2 
    537          CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 
    538 #else 
    539          nidom_ptr = FLIO_DOM_NONE 
    540 #endif 
    541       IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init') 
    542       ! 
     255 
     256         ! Initialise arrays to zero because diatpr is called before they are first calculated 
     257         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
     258         htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp   
     259         htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp  
     260         ! 
    543261      ENDIF  
    544262      !  
    … …  
    546264 
    547265 
    548    SUBROUTINE dia_ptr_wri( kt ) 
    549       !!--------------------------------------------------------------------- 
    550       !!                ***  ROUTINE dia_ptr_wri  *** 
    551       !! 
    552       !! ** Purpose :   output of poleward fluxes 
    553       !! 
    554       !! ** Method  :   NetCDF file 
    555       !!---------------------------------------------------------------------- 
    556       !! 
    557       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    558       !! 
    559       INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw 
    560       INTEGER, SAVE ::   ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc 
    561       INTEGER, SAVE ::           ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30 
    562       INTEGER, SAVE ::   ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 
    563       !! 
    564       CHARACTER (len=40) ::   clhstnam, clop, clop_once, cl_comment   ! temporary names 
    565       INTEGER            ::   iline, it, itmod, ji, jj, jk            ! 
    566 #if defined key_iomput 
    567       INTEGER            ::   inum                                    ! temporary logical unit 
     266   FUNCTION dia_ptr_alloc() 
     267      !!---------------------------------------------------------------------- 
     268      !!                    ***  ROUTINE dia_ptr_alloc  *** 
     269      !!---------------------------------------------------------------------- 
     270      INTEGER               ::   dia_ptr_alloc   ! return value 
     271      INTEGER, DIMENSION(3) ::   ierr 
     272      !!---------------------------------------------------------------------- 
     273      ierr(:) = 0 
     274      ! 
     275      ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
     276         &      htr_adv(jpj) , str_adv(jpj) ,   & 
     277         &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  ) 
     278         ! 
     279      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
     280      ! 
     281      ALLOCATE( btm30(jpi,jpj), STAT=ierr(3)  ) 
     282 
     283         ! 
     284      dia_ptr_alloc = MAXVAL( ierr ) 
     285      IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc ) 
     286      ! 
     287   END FUNCTION dia_ptr_alloc 
     288 
     289 
     290   FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval ) 
     291      !!---------------------------------------------------------------------- 
     292      !!                    ***  ROUTINE ptr_sj_3d  *** 
     293      !! 
     294      !! ** Purpose :   i-k sum computation of a j-flux array 
     295      !! 
     296      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
     297      !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     298      !! 
     299      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
     300      !!---------------------------------------------------------------------- 
     301      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point 
     302      REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     303      ! 
     304      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
     305      INTEGER                  ::   ijpj         ! ??? 
     306      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
     307      !!-------------------------------------------------------------------- 
     308      ! 
     309      p_fval => p_fval1d 
     310 
     311      ijpj = jpj 
     312      p_fval(:) = 0._wp 
     313      IF( PRESENT( pmsk ) ) THEN  
     314         DO jk = 1, jpkm1 
     315            DO jj = 2, jpjm1 
     316               DO ji = fs_2, fs_jpim1   ! Vector opt. 
     317                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 
     318               END DO 
     319            END DO 
     320         END DO 
     321      ELSE 
     322         DO jk = 1, jpkm1 
     323            DO jj = 2, jpjm1 
     324               DO ji = fs_2, fs_jpim1   ! Vector opt. 
     325                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)  
     326               END DO 
     327            END DO 
     328         END DO 
     329      ENDIF 
     330#if defined key_mpp_mpi 
     331      IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl) 
    568332#endif 
    569       REAL(wp)           ::   zsto, zout, zdt, zjulian                ! temporary scalars 
    570       !! 
    571       REAL(wp), POINTER, DIMENSION(:)   ::   zphi, zfoo    ! 1D workspace 
    572       REAL(wp), POINTER, DIMENSION(:,:) ::   z_1           ! 2D workspace 
    573       !!--------------------------------------------------------------------  
    574       ! 
    575       CALL wrk_alloc( jpj       , zphi , zfoo ) 
    576       CALL wrk_alloc( jpj , jpk , z_1  ) 
    577  
    578       ! define time axis 
    579       it    = kt / nn_fptr 
    580       itmod = kt - nit000 + 1 
    581        
    582       ! Initialization 
    583       ! -------------- 
    584       IF( kt == nit000 ) THEN 
    585          niter = ( nit000 - 1 ) / nn_fptr 
    586          zdt = rdt 
    587          IF( nacc == 1 )   zdt = rdtmin 
    588          ! 
    589          IF(lwp) THEN 
    590             WRITE(numout,*) 
    591             WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 
    592             WRITE(numout,*) '~~~~~~~~~~~~' 
    593          ENDIF 
    594  
    595          ! Reference latitude (used in plots) 
    596          ! ------------------ 
    597          !                                           ! ======================= 
    598          IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations 
    599             !                                        ! ======================= 
    600             IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole 
    601             IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole 
    602             IF( jp_cfg == 1   )   iline =  96   ! i-line that passes near the North Pole 
    603             IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole 
    604             IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole 
    605             zphi(1:jpj) = 0._wp 
    606             DO ji = mi0(iline), mi1(iline)  
    607                zphi(1:jpj) = gphiv(ji,:)         ! if iline is in the local domain 
    608                ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 
    609                IF( jp_cfg == 05 ) THEN 
    610                   DO jj = mj0(jpjdta), mj1(jpjdta)  
    611                      zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp 
    612                      zphi( jj ) = MIN( zphi(jj), 90._wp ) 
    613                   END DO 
    614                END IF 
    615                IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
    616                   DO jj = mj0(jpjdta-1), mj1(jpjdta-1)  
    617                      zphi( jj ) = 88.5_wp 
    618                   END DO 
    619                   DO jj = mj0(jpjdta  ), mj1(jpjdta  )  
    620                      zphi( jj ) = 89.5_wp 
    621                   END DO 
    622                END IF 
    623             END DO 
    624             ! provide the correct zphi to all local domains 
     333      ! 
     334   END FUNCTION ptr_sj_3d 
     335 
     336 
     337   FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval ) 
     338      !!---------------------------------------------------------------------- 
     339      !!                    ***  ROUTINE ptr_sj_2d  *** 
     340      !! 
     341      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
     342      !! 
     343      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
     344      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     345      !! 
     346      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
     347      !!---------------------------------------------------------------------- 
     348      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point 
     349      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     350      ! 
     351      INTEGER                  ::   ji,jj       ! dummy loop arguments 
     352      INTEGER                  ::   ijpj        ! ??? 
     353      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
     354      !!-------------------------------------------------------------------- 
     355      !  
     356      p_fval => p_fval1d 
     357 
     358      ijpj = jpj 
     359      p_fval(:) = 0._wp 
     360      IF( PRESENT( pmsk ) ) THEN  
     361         DO jj = 2, jpjm1 
     362            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     363               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 
     364            END DO 
     365         END DO 
     366      ELSE 
     367         DO jj = 2, jpjm1 
     368            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     369               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 
     370            END DO 
     371         END DO 
     372      ENDIF 
    625373#if defined key_mpp_mpi 
    626             CALL mpp_sum( zphi, jpj, ncomm_znl )         
     374      CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 
    627375#endif 
    628             !                                        ! ======================= 
    629          ELSE                                        !   OTHER configurations  
    630             !                                        ! ======================= 
    631             zphi(1:jpj) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line 
    632             ! 
    633          ENDIF 
    634          ! 
    635          ! Work only on westmost processor (will not work if mppini2 is used) 
     376      !  
     377   END FUNCTION ptr_sj_2d 
     378 
     379 
     380   FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval ) 
     381      !!---------------------------------------------------------------------- 
     382      !!                    ***  ROUTINE ptr_sjk  *** 
     383      !! 
     384      !! ** Purpose :   i-sum computation of an array 
     385      !! 
     386      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
     387      !! 
     388      !! ** Action  : - p_fval: i-mean poleward flux of pva 
     389      !!---------------------------------------------------------------------- 
     390      !! 
     391      IMPLICIT none 
     392      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point 
     393      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     394      !! 
     395      INTEGER                           :: ji, jj, jk ! dummy loop arguments 
     396      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    636397#if defined key_mpp_mpi 
    637          IF( l_znl_root ) THEN  
     398      INTEGER, DIMENSION(1) ::   ish 
     399      INTEGER, DIMENSION(2) ::   ish2 
     400      INTEGER               ::   ijpjjpk 
     401      REAL(wp), DIMENSION(jpj*jpk) ::   zwork    ! mask flux array at V-point 
    638402#endif 
    639             ! 
    640             ! OPEN netcdf file  
    641             ! ---------------- 
    642             ! Define frequency of output and means 
    643             zsto = nn_fptr * zdt 
    644             IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!) 
    645                clop      = "ave(only(x))" 
    646                clop_once = "once(only(x))" 
    647             ELSE                       ! no use of the mask value (require less cpu time) 
    648                clop      = "ave(x)"        
    649                clop_once = "once" 
    650             ENDIF 
    651  
    652             zout = nn_fwri * zdt 
    653             zfoo(1:jpj) = 0._wp 
    654  
    655             CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )  ! Compute julian date from starting date of the run 
    656             zjulian = zjulian - adatrj                         ! set calendar origin to the beginning of the experiment 
    657  
    658 #if defined key_iomput 
    659             ! Requested by IPSL people, use by their postpro... 
    660             IF(lwp) THEN 
    661                CALL dia_nam( clhstnam, nn_fwri,' ' ) 
    662                CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    663                WRITE(inum,*) clhstnam 
    664                CLOSE(inum) 
    665             ENDIF 
     403      !!-------------------------------------------------------------------- 
     404      ! 
     405      p_fval => p_fval2d 
     406 
     407      p_fval(:,:) = 0._wp 
     408      ! 
     409      IF( PRESENT( pmsk ) ) THEN  
     410         DO jk = 1, jpkm1 
     411            DO jj = 2, jpjm1 
     412!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
     413               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     414                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 
     415               END DO 
     416            END DO 
     417         END DO 
     418      ELSE  
     419         DO jk = 1, jpkm1 
     420            DO jj = 2, jpjm1 
     421               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     422                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 
     423               END DO 
     424            END DO 
     425         END DO 
     426      END IF 
     427      ! 
     428#if defined key_mpp_mpi 
     429      ijpjjpk = jpj*jpk 
     430      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
     431      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
     432      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
     433      p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    666434#endif 
    667  
    668             CALL dia_nam( clhstnam, nn_fwri, 'diaptr' ) 
    669             IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 
    670  
    671             ! Horizontal grid : zphi() 
    672             CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
    673                1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr) 
    674             ! Vertical grids : gdept_1d, gdepw_1d 
    675             CALL histvert( numptr, "deptht", "Vertical T levels",   & 
    676                &                   "m", jpk, gdept_1d, ndepidzt, "down" ) 
    677             CALL histvert( numptr, "depthw", "Vertical W levels",   & 
    678                &                   "m", jpk, gdepw_1d, ndepidzw, "down" ) 
    679             ! 
    680             CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex  , ndim  )      ! Lat-Depth 
    681             CALL wheneq ( jpj    , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h )     ! Lat 
    682  
    683             IF( ln_subbas ) THEN 
    684                z_1(:,1) = 1._wp 
    685                WHERE ( gphit(jpi/2,:) < -30._wp )   z_1(:,1) = 0._wp 
    686                DO jk = 2, jpk 
    687                   z_1(:,jk) = z_1(:,1) 
    688                END DO 
    689                !                       ! Atlantic (jn=2) 
    690                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)         , 1._wp), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth 
    691                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth 
    692                CALL wheneq ( jpj    , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 
    693                !                       ! Pacific (jn=3) 
    694                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)         , 1._wp), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth 
    695                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth 
    696                CALL wheneq ( jpj    , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 
    697                !                       ! Indian (jn=4) 
    698                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)         , 1._wp), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth 
    699                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth 
    700                CALL wheneq ( jpj    , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 
    701                !                       ! Indo-Pacific (jn=5) 
    702                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)         , 1._wp), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth 
    703                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth 
    704                CALL wheneq ( jpj    , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 
    705             ENDIF 
    706             !  
    707 #if defined key_diaeiv 
    708             cl_comment = ' (Bolus part included)' 
    709 #else 
    710             cl_comment = '                      ' 
    711 #endif 
    712             IF( ln_diaznl ) THEN             !  Zonal mean T and S 
    713                CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   & 
    714                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    715                CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   & 
    716                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    717  
    718                CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   & 
    719                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    720                ! 
    721                IF (ln_subbas) THEN  
    722                   CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   & 
    723                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    724                   CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   & 
    725                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    726                   CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   & 
    727                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    728  
    729                   CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   & 
    730                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    731                   CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   & 
    732                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    733                   CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   & 
    734                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    735  
    736                   CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   & 
    737                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    738                   CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   & 
    739                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    740                   CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   & 
    741                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    742  
    743                   CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   & 
    744                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    745                   CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   & 
    746                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    747                   CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   & 
    748                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    749                ENDIF 
    750             ENDIF 
    751             ! 
    752             !  Meridional Stream-Function (Eulerian and Bolus) 
    753             CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   & 
    754                1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    755             IF( ln_subbas .AND. ln_diaznl ) THEN 
    756                CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   & 
    757                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    758                CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   & 
    759                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    760                CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   & 
    761                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    762                CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 
    763                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    764             ENDIF 
    765             ! 
    766             !  Heat transport  
    767             CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   & 
    768                "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    769             CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   & 
    770                "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    771             IF ( ln_ptrcomp ) THEN  
    772                CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   & 
    773                   "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    774             END IF 
    775             IF( ln_subbas ) THEN 
    776                CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  & 
    777                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    778                CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  & 
    779                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    780                CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  & 
    781                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    782                CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 
    783                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    784             ENDIF 
    785             ! 
    786             !  Salt transport  
    787             CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   & 
    788                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    789             CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   & 
    790                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    791             IF ( ln_ptrcomp ) THEN  
    792                CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   & 
    793                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    794             END IF 
    795 #if defined key_diaeiv 
    796             ! Eddy induced velocity 
    797             CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   & 
    798                "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    799             CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   & 
    800                "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    801             CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   & 
    802                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    803 #endif 
    804             IF( ln_subbas ) THEN 
    805                CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  & 
    806                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    807                CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   & 
    808                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    809                CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    & 
    810                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    811                CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  & 
    812                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    813             ENDIF 
    814             ! 
    815             CALL histend( numptr ) 
    816             ! 
    817          END IF 
    818 #if defined key_mpp_mpi 
    819       END IF 
    820 #endif 
    821  
    822 #if defined key_mpp_mpi 
    823       IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN 
    824 #else 
    825       IF( MOD( itmod, nn_fptr ) == 0  ) THEN 
    826 #endif 
    827          niter = niter + 1 
    828  
    829          IF( ln_diaznl ) THEN  
    830             CALL histwrite( numptr, "zosrfglo", niter, sjk  (:,:,1) , ndim, ndex ) 
    831             CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1)  , ndim, ndex ) 
    832             CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1)  , ndim, ndex ) 
    833  
    834             IF (ln_subbas) THEN  
    835                CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl ) 
    836                CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac ) 
    837                CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind ) 
    838                CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc ) 
    839  
    840                CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2)  , ndim_atl, ndex_atl ) 
    841                CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2)  , ndim_atl, ndex_atl ) 
    842                CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3)  , ndim_pac, ndex_pac ) 
    843                CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3)  , ndim_pac, ndex_pac ) 
    844                CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4)  , ndim_ind, ndex_ind ) 
    845                CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4)  , ndim_ind, ndex_ind ) 
    846                CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5)  , ndim_ipc, ndex_ipc ) 
    847                CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5)  , ndim_ipc, ndex_ipc ) 
    848             END IF 
    849          ENDIF 
    850  
    851          ! overturning outputs: 
    852          CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex ) 
    853          IF( ln_subbas .AND. ln_diaznl ) THEN 
    854             CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 ) 
    855             CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 ) 
    856             CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 ) 
    857             CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 ) 
    858          ENDIF 
    859 #if defined key_diaeiv 
    860          CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim  , ndex   ) 
    861 #endif 
    862  
    863          ! heat transport outputs: 
    864          IF( ln_subbas ) THEN 
    865             CALL histwrite( numptr, "sohtatl", niter, htr(:,2)  , ndim_h_atl_30, ndex_h_atl_30 ) 
    866             CALL histwrite( numptr, "sohtpac", niter, htr(:,3)  , ndim_h_pac_30, ndex_h_pac_30 ) 
    867             CALL histwrite( numptr, "sohtind", niter, htr(:,4)  , ndim_h_ind_30, ndex_h_ind_30 ) 
    868             CALL histwrite( numptr, "sohtipc", niter, htr(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    869             CALL histwrite( numptr, "sostatl", niter, str(:,2)  , ndim_h_atl_30, ndex_h_atl_30 ) 
    870             CALL histwrite( numptr, "sostpac", niter, str(:,3)  , ndim_h_pac_30, ndex_h_pac_30 ) 
    871             CALL histwrite( numptr, "sostind", niter, str(:,4)  , ndim_h_ind_30, ndex_h_ind_30 ) 
    872             CALL histwrite( numptr, "sostipc", niter, str(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    873          ENDIF 
    874  
    875          CALL histwrite( numptr, "sophtadv", niter, htr_adv     , ndim_h, ndex_h ) 
    876          CALL histwrite( numptr, "sophtldf", niter, htr_ldf     , ndim_h, ndex_h ) 
    877          CALL histwrite( numptr, "sopstadv", niter, str_adv     , ndim_h, ndex_h ) 
    878          CALL histwrite( numptr, "sopstldf", niter, str_ldf     , ndim_h, ndex_h ) 
    879          IF( ln_ptrcomp ) THEN  
    880             CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h ) 
    881             CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h ) 
    882          ENDIF 
    883 #if defined key_diaeiv 
    884          CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1)  , ndim_h, ndex_h ) 
    885          CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1)  , ndim_h, ndex_h ) 
    886 #endif 
    887          ! 
    888       ENDIF 
    889       ! 
    890       CALL wrk_dealloc( jpj      , zphi , zfoo ) 
    891       CALL wrk_dealloc( jpj , jpk, z_1 ) 
    892       ! 
    893   END SUBROUTINE dia_ptr_wri 
     435      ! 
     436   END FUNCTION ptr_sjk 
     437 
    894438 
    895439   !!====================================================================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5107 r5350  
    7878   !!---------------------------------------------------------------------- 
    7979   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    80    !! $Id $ 
     80   !! $Id$ 
    8181   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8282   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5342 r5350  
    135135      !!---------------------------------------------------------------------- 
    136136      USE ioipsl 
    137       NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,   & 
    138          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock  ,   & 
     137      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     138         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     139         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    139140         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    140141      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    … …  
    169170         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp 
    170171         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in 
     172         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir 
    171173         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out 
     174         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir 
    172175         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
    173176         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler 
    … …  
    178181         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
    179182         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
    180          WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     183         IF( ln_rst_list ) THEN 
     184            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist 
     185         ELSE 
     186            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     187         ENDIF 
    181188         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
    182189         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
    … …  
    196203      ninist = nn_istate 
    197204      nstock = nn_stock 
     205      nstocklist = nn_stocklist 
    198206      nwrite = nn_write 
    199207      neuler = nn_euler 
    200       IF ( neuler == 1 .AND. .NOT.ln_rstart ) THEN 
     208      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
    201209         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 
    202210         CALL ctl_warn( ctmp1 ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5120 r5350  
    472472         risfdep(:,:)=0.e0 
    473473         misfdep(:,:)=1 
    474          ! 
    475          ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code 
    476          IF( cp_cfg == "isomip" .AND. ln_isfcav ) THEN  
    477             risfdep(:,:)=200.e0  
    478             misfdep(:,:)=1  
    479             ij0 = 1 ; ij1 = 40  
    480             DO jj = mj0(ij0), mj1(ij1)  
    481                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp  
    482             END DO  
    483             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp  
    484          !  
    485          ELSEIF ( cp_cfg == "isomip2" .AND. ln_isfcav ) THEN 
    486          !  
    487             risfdep(:,:)=0.e0 
    488             misfdep(:,:)=1 
    489             ij0 = 1 ; ij1 = 40 
    490             DO jj = mj0(ij0), mj1(ij1) 
    491                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    492             END DO 
    493             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
    494          END IF 
    495474         ! 
    496475         DEALLOCATE( idta, zdta ) 
    … …  
    969948      !! 
    970949      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    971       INTEGER  ::   ik, it          ! temporary integers 
     950      INTEGER  ::   ik, it, ikb, ikt ! temporary integers 
    972951      LOGICAL  ::   ll_print         ! Allow  control print for debugging 
    973952      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    … …  
    11521131      IF ( ln_isfcav ) THEN 
    11531132      ! (ISF) define e3uw (adapted for 2 cells in the water column) 
    1154       ! Need to test if the modification of only mikt and mbkt levels is enough 
    1155          DO jk = 2,jpk                           
    1156             DO jj = 1, jpjm1  
    1157                DO ji = 1, fs_jpim1   ! vector opt.  
    1158                   e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj  ,jk) ) & 
    1159                     &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj  ,jk-1) ) 
    1160                   e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji  ,jj+1,jk) ) & 
    1161                     &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji  ,jj+1,jk-1) ) 
    1162                END DO  
    1163             END DO  
     1133         DO jj = 2, jpjm1  
     1134            DO ji = 2, fs_jpim1   ! vector opt.  
     1135               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 
     1136               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 
     1137               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) & 
     1138                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) ) 
     1139               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 
     1140               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 
     1141               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) & 
     1142                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) ) 
     1143            END DO 
    11641144         END DO 
    11651145      END IF 
    1166        
     1146 
    11671147      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
    11681148      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    … …  
    15381518  
    15391519 ! remove single point "bay" on isf coast line in the ice shelf draft' 
    1540          DO jk = 1, jpk 
     1520         DO jk = 2, jpk 
    15411521            WHERE (misfdep==0) misfdep=jpk 
    15421522            zmask=0 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    41    !! $Id: dtatem.F90 2392 2010-11-15 21:20:05Z gm $  
     41   !! $Id$  
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r5120 r5350  
    6969      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    7070      !!---------------------------------------------------------------------- 
    71       ! - ML - needed for initialization of e3t_b 
    72       INTEGER  ::  ji,jj,jk     ! dummy loop indices 
    73       REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::  zuvd    ! U & V data workspace 
     71      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     72      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
    7473      !!---------------------------------------------------------------------- 
    7574      ! 
    … …  
    8483      IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data 
    8584 
    86       rhd  (:,:,:  ) = 0._wp 
    87       rhop (:,:,:  ) = 0._wp 
    88       rn2  (:,:,:  ) = 0._wp 
    89       tsa  (:,:,:,:) = 0._wp    
    90       rab_b(:,:,:,:) = 0._wp 
    91       rab_n(:,:,:,:) = 0._wp 
     85      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
     86      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
     87      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk 
     88      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    9289 
    9390      IF( ln_rstart ) THEN                    ! Restart from a file 
    … …  
    113110         ELSEIF( cp_cfg == 'gyre' ) THEN          
    114111            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields 
    115         ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN 
    116             IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain'  
    117             tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields  
    118             tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:) 
    119             tsb(:,:,:,:)=tsn(:,:,:,:)   
    120112         ELSE                                    ! Initial T-S, U-V fields read in files 
    121113            IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5123 r5350  
    5151   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
    5252   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     53   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp  
    5354   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    5455 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r5120 r5350  
    55   !!============================================================================== 
    66   !! History :  1.0  !  2006-11  (G. Madec)  Original code 
    7    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     7   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
     8   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option  
    89   !!---------------------------------------------------------------------- 
    910 
    … …  
    1718   USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine) 
    1819   USE dynzad          ! vertical advection               (dyn_zad      routine) 
     20   ! 
    1921   USE in_out_manager  ! I/O manager 
    2022   USE lib_mpp         ! MPP library 
    … …  
    2527 
    2628   PUBLIC dyn_adv       ! routine called by step module 
    27    PUBLIC dyn_adv_init  ! routine called by opa module 
     29   PUBLIC dyn_adv_init  ! routine called by opa  module 
    2830  
     31   !                                    !* namdyn_adv namelist * 
    2932   LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag 
     33   INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth 
    3034   LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag 
    3135   LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag 
    … …  
    3842#  include "vectopt_loop_substitute.h90" 
    3943   !!---------------------------------------------------------------------- 
    40    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     44   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    4145   !! $Id$ 
    4246   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6367      SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend 
    6468      CASE ( 0 )      
    65                       CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy 
    66                       CALL dyn_zad     ( kt )    ! vector form : vertical advection 
     69                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     70                      CALL dyn_zad     ( kt )               ! vector form : vertical advection 
    6771      CASE ( 1 )      
    68                       CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy 
    69                       CALL dyn_zad_zts ( kt )    ! vector form : vertical advection with sub-timestepping 
     72                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     73                      CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping 
    7074      CASE ( 2 )  
    71                       CALL dyn_adv_cen2( kt )    ! 2nd order centered scheme 
     75                      CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
    7276      CASE ( 3 )    
    73                       CALL dyn_adv_ubs ( kt )    ! 3rd order UBS      scheme 
     77                      CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme 
    7478      ! 
    75       CASE (-1 )                                 ! esopa: test all possibility with control print 
    76                       CALL dyn_keg     ( kt ) 
     79      CASE (-1 )                                            ! esopa: test all possibility with control print 
     80                      CALL dyn_keg     ( kt, nn_dynkeg ) 
    7781                      CALL dyn_zad     ( kt ) 
    7882                      CALL dyn_adv_cen2( kt ) 
    … …  
    9296      !!              momentum advection formulation & scheme and set nadv 
    9397      !!---------------------------------------------------------------------- 
    94       INTEGER ::   ioptio 
    95       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    96       !! 
    97       NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 
     98      INTEGER ::   ioptio, ios   ! Local integer 
     99      ! 
     100      NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 
    98101      !!---------------------------------------------------------------------- 
    99  
     102      ! 
    100103      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    101104      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    … …  
    112115         WRITE(numout,*) '~~~~~~~~~~~' 
    113116         WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
    114          WRITE(numout,*) '          Vector/flux form (T/F)             ln_dynadv_vec  = ', ln_dynadv_vec 
    115          WRITE(numout,*) '          2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2 
    116          WRITE(numout,*) '          3rd order UBS advection scheme     ln_dynadv_ubs  = ', ln_dynadv_ubs 
    117          WRITE(numout,*) '      Sub timestepping of vertical advection ln_dynzad_zts  = ', ln_dynzad_zts 
     117         WRITE(numout,*) '          Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec 
     118         WRITE(numout,*) '          = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg 
     119         WRITE(numout,*) '          2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2 
     120         WRITE(numout,*) '          3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs 
     121         WRITE(numout,*) '          Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts 
    118122      ENDIF 
    119123 
    … …  
    126130      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) 
    127131      IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   & 
    128           CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 
    129       IF( ln_dynzad_zts .AND. ln_isfcav )   & 
    130           CALL ctl_stop( 'Sub timestepping of vertical advection does not work with ln_isfcav = .TRUE.' ) 
     132         CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 
     133      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   &   
     134         CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
    131135 
    132136      !                               ! Set nadv 
    … …  
    139143      IF(lwp) THEN                    ! Print the choice 
    140144         WRITE(numout,*) 
    141          IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used' 
     145         IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used'  
    142146         IF( nadv ==  1 )   WRITE(numout,*) '         vector form : keg + zad_zts + vor is used' 
     147         IF( nadv ==  0 .OR. nadv ==  1 ) THEN 
     148            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) 'with Centered standard keg scheme' 
     149            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) 'with Hollingsworth keg scheme' 
     150         ENDIF 
    143151         IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used' 
    144152         IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used' 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r5120 r5350  
    956956      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh 
    957957      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
     958      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n 
    958959      !!---------------------------------------------------------------------- 
    959960      ! 
    960961      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
    961962      CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 
     963      CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n ) 
    962964      ! 
    963965      IF( kt == nit000 ) THEN 
    … …  
    10401042 
    10411043      ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 
     1044 
     1045      ! Prepare zsshu_n and zsshv_n 
    10421046      DO jj = 2, jpjm1 
    10431047        DO ji = 2, jpim1 
    1044           zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshu_n for ztilde compilation 
    1045           zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshv_n for ztilde compilation 
     1048          zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * & 
     1049                         & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
     1050          zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * & 
     1051                         & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
     1052        END DO 
     1053      END DO 
     1054 
     1055      DO jj = 2, jpjm1 
     1056        DO ji = 2, jpim1 
     1057          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad)  
     1058          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad) 
    10461059        END DO 
    10471060      END DO 
    … …  
    12051218      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
    12061219      CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 
     1220      CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n ) 
    12071221      ! 
    12081222   END SUBROUTINE hpg_prj 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r4990 r5350  
    44   !! Ocean dynamics:  kinetic energy gradient trend 
    55   !!====================================================================== 
    6    !! History :  1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code 
    7    !!            7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg 
    8    !!            9.0  !  02-07  (G. Madec)  F90: Free form and module 
     6   !! History :  1.0  !  1987-09  (P. Andrich, M.-A. Foujols)  Original code 
     7   !!            7.0  !  1997-05  (G. Madec)  Split dynber into dynkeg and dynhpg 
     8   !!  NEMO      1.0  !  2002-07  (G. Madec)  F90: Free form and module 
     9   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option  
    910   !!---------------------------------------------------------------------- 
    1011    
    … …  
    1819   ! 
    1920   USE in_out_manager  ! I/O manager 
     21   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2022   USE lib_mpp         ! MPP library 
    2123   USE prtctl          ! Print control 
    … …  
    2830   PUBLIC   dyn_keg    ! routine called by step module 
    2931    
     32   INTEGER, PARAMETER, PUBLIC  ::   nkeg_C2  = 0   !: 2nd order centered scheme (standard scheme) 
     33   INTEGER, PARAMETER, PUBLIC  ::   nkeg_HW  = 1   !: Hollingsworth et al., QJRMS, 1983 
     34   ! 
     35   REAL(wp) ::   r1_48 = 1._wp / 48._wp   !: =1/(4*2*6) 
     36    
    3037   !! * Substitutions 
    3138#  include "vectopt_loop_substitute.h90" 
    3239   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     40   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    3441   !! $Id$  
    3542   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3744CONTAINS 
    3845 
    39    SUBROUTINE dyn_keg( kt ) 
     46   SUBROUTINE dyn_keg( kt, kscheme ) 
    4047      !!---------------------------------------------------------------------- 
    4148      !!                  ***  ROUTINE dyn_keg  *** 
    … …  
    4552      !!      general momentum trend. 
    4653      !! 
    47       !! ** Method  :   Compute the now horizontal kinetic energy  
     54      !! ** Method  : * kscheme = nkeg_C2 : 2nd order centered scheme that  
     55      !!      conserve kinetic energy. Compute the now horizontal kinetic energy  
    4856      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ] 
     57      !!              * kscheme = nkeg_HW : Hollingsworth correction following 
     58      !!      Arakawa (2001). The now horizontal kinetic energy is given by: 
     59      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  ) 
     60      !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ] 
     61      !!       
    4962      !!      Take its horizontal gradient and add it to the general momentum 
    5063      !!      trend (ua,va). 
    … …  
    5467      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
    5568      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
     69      !! 
     70      !! ** References : Arakawa, A., International Geophysics 2001. 
     71      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 
    5672      !!---------------------------------------------------------------------- 
    57       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     73      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
     74      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
    5875      ! 
    5976      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    6380      !!---------------------------------------------------------------------- 
    6481      ! 
    65       IF( nn_timing == 1 )  CALL timing_start('dyn_keg') 
     82      IF( nn_timing == 1 )   CALL timing_start('dyn_keg') 
    6683      ! 
    67       CALL wrk_alloc( jpi, jpj, jpk, zhke ) 
     84      CALL wrk_alloc( jpi,jpj,jpk,  zhke ) 
    6885      ! 
    6986      IF( kt == nit000 ) THEN 
    7087         IF(lwp) WRITE(numout,*) 
    71          IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend' 
     88         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme 
    7289         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7390      ENDIF 
    7491 
    7592      IF( l_trddyn ) THEN           ! Save ua and va trends 
    76          CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     93         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    7794         ztrdu(:,:,:) = ua(:,:,:)  
    7895         ztrdv(:,:,:) = va(:,:,:)  
    7996      ENDIF 
    8097       
    81       !                                                ! =============== 
    82       DO jk = 1, jpkm1                                 ! Horizontal slab 
    83          !                                             ! =============== 
    84          DO jj = 2, jpj         ! Horizontal kinetic energy at T-point 
    85             DO ji = fs_2, jpi   ! vector opt. 
    86                zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    87                   &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  ) 
    88                zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    89                   &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  ) 
    90                zhke(ji,jj,jk) = zv + zu 
    91 !!gm simplier coding  ==>>   ~ faster 
    92 !    don't forget to suppress local zu zv scalars 
    93 !               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    94 !                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
    95 !                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    96 !                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) 
    97 !!gm end <<== 
    98             END DO   
    99          END DO   
    100          DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
     98      zhke(:,:,jpk) = 0._wp 
     99       
     100      SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==! 
     101      ! 
     102      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
     103         DO jk = 1, jpkm1 
     104            DO jj = 2, jpj 
     105               DO ji = fs_2, jpi   ! vector opt. 
     106                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     107                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) 
     108                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
     109                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) 
     110                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
     111               END DO   
     112            END DO 
     113         END DO 
     114         ! 
     115      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
     116         DO jk = 1, jpkm1 
     117            DO jj = 2, jpjm1        
     118               DO ji = fs_2, jpim1   ! vector opt. 
     119                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    & 
     120                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  & 
     121                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   & 
     122                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) 
     123                     ! 
     124                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    & 
     125                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  & 
     126                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   & 
     127                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) 
     128                  zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
     129               END DO   
     130            END DO 
     131         END DO 
     132         CALL lbc_lnk( zhke, 'T', 1. ) 
     133         ! 
     134      END SELECT 
     135      ! 
     136      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
     137         DO jj = 2, jpjm1 
    101138            DO ji = fs_2, fs_jpim1   ! vector opt. 
    102139               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    … …  
    104141            END DO  
    105142         END DO 
    106 !!gm idea to be tested  ==>>   is it faster on scalar computers ? 
    107 !         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
    108 !            DO ji = fs_2, fs_jpim1   ! vector opt. 
    109 !               ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj  ,jk) * un(ji+1,jj  ,jk)   & 
    110 !                  &                                   + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk)   & 
    111 !                  &                                   + vn(ji+1,jj  ,jk) * vn(ji+1,jj  ,jk)   & 
    112 !                  ! 
    113 !                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    114 !                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    115 !                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj) 
    116 !                  ! 
    117 !               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   & 
    118 !                  &                                   + un(ji  ,jj+1,jk) * un(ji  ,jj+1,jk)   & 
    119 !                  &                                   + vn(ji  ,jj+1,jk) * vn(ji  ,jj+1,jk)   & 
    120 !                  ! 
    121 !                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    122 !                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
    123 !                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj) 
    124 !            END DO  
    125 !         END DO 
    126 !!gm en idea            <<== 
    127          !                                             ! =============== 
    128       END DO                                           !   End of slab 
    129       !                                                ! =============== 
    130  
    131       IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic 
     143      END DO 
     144      ! 
     145      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    132146         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    133147         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    134148         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    135          CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     149         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    136150      ENDIF 
    137151      ! 
    … …  
    139153         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    140154      ! 
    141       CALL wrk_dealloc( jpi, jpj, jpk, zhke ) 
     155      CALL wrk_dealloc( jpi,jpj,jpk,  zhke ) 
    142156      ! 
    143       IF( nn_timing == 1 )  CALL timing_stop('dyn_keg') 
     157      IF( nn_timing == 1 )   CALL timing_stop('dyn_keg') 
    144158      ! 
    145159   END SUBROUTINE dyn_keg 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    6969   !!---------------------------------------------------------------------- 
    7070 
     71   !! $Id$ 
    7172 CONTAINS 
    7273 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5120 r5350  
    7979   !!---------------------------------------------------------------------- 
    8080   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    81    !! $Id: dynspg_ts.F90 
     81   !! $Id$ 
    8282   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8383   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90

    • Property svn:keywords set to Id
    r3294 r5350  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    38    !! $Header: 
     38   !! $Id$ 
    3939   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4040   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r3294 r5350  
    5050   !!---------------------------------------------------------------------- 
    5151   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    52    !! $Header: 
     52   !! $Id$ 
    5353   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5454   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    146146   !!---------------------------------------------------------------------- 
    147147   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    148    !! $Id: sbc_oce.F90 3340 2012-04-02 11:05:35Z sga $ 
     148   !! $Id$ 
    149149   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    150150   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90

    • Property svn:keywords set to Id
    r3821 r5350  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    35    !! $Id:$ 
     35   !! $Id$ 
    3636   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

    • Property svn:keywords set to Id
    r3614 r5350  
    7676   !!---------------------------------------------------------------------- 
    7777   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    78    !! $Id:$ 
     78   !! $Id$ 
    7979   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8080   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    2828   !!---------------------------------------------------------------------- 
    2929   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    30    !! $Id:$ 
     30   !! $Id$ 
    3131   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3232   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    43    !! $Id:$ 
     43   !! $Id$ 
    4444   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    6767   !!---------------------------------------------------------------------- 
    6868   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    69    !! $Id:$ 
     69   !! $Id$ 
    7070   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7171   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    44    !! $Id:$ 
     44   !! $Id$ 
    4545   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    … …  
    6464                                                                                            ! start and count arrays 
    6565      LOGICAL                      ::   ll_found_restart 
     66      CHARACTER(len=256)           ::   cl_path 
    6667      CHARACTER(len=256)           ::   cl_filename 
    6768      CHARACTER(len=NF90_MAX_NAME) ::   cl_dname 
    … …  
    7071      !!---------------------------------------------------------------------- 
    7172 
    72       ! Find a restart file 
     73      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts.  
     74      cl_path = TRIM(cn_ocerst_indir) 
     75      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
    7376      cl_filename = ' ' 
    7477      IF ( lk_mpp ) THEN 
    7578         cl_filename = ' ' 
    7679         WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1 
    77          INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart ) 
     80         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    7881      ELSE 
    7982         cl_filename = 'restart_icebergs.nc' 
    80          INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart ) 
     83         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    8184      ENDIF 
    8285 
    … …  
    8689 
    8790      IF (nn_verbose_level >= 0 .AND. lwp)  & 
    88          WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_filename) 
    89  
    90       nret = NF90_OPEN(TRIM(cl_filename), NF90_NOWRITE, ncid) 
     91         WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename) 
     92 
     93      nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid) 
    9194      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed') 
    9295 
    … …  
    228231      INTEGER ::   jn   ! dummy loop index 
    229232      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
     233      CHARACTER(len=256)     :: cl_path 
    230234      CHARACTER(len=256)     :: cl_filename 
    231235      TYPE(iceberg), POINTER :: this 
    … …  
    233237      !!---------------------------------------------------------------------- 
    234238 
     239      ! Assume we write iceberg restarts to same directory as ocean restarts. 
     240      cl_path = TRIM(cn_ocerst_outdir) 
     241      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
    235242      IF( lk_mpp ) THEN 
    236          WRITE(cl_filename,'("icebergs_",I8.8,"_restart_",I4.4,".nc")') kt, narea-1 
     243         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1 
    237244      ELSE 
    238          WRITE(cl_filename,'("icebergs_",I8.8,"_restart.nc")') kt 
    239       ENDIF 
    240       IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_filename) 
    241  
    242       nret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ncid) 
     245         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt 
     246      ENDIF 
     247      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename) 
     248 
     249      nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid) 
    243250      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed') 
    244251 
    … …  
    372379         ENDIF 
    373380      ENDDO 
    374       IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_ice  written' 
     381      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice  written' 
    375382 
    376383      nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) ) 
    … …  
    379386      nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) ) 
    380387      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed') 
    381       IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_heat written' 
     388      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written' 
    382389 
    383390      nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) ) 
    … …  
    385392      nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) ) 
    386393      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed') 
    387       IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: calving written' 
     394      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written' 
    388395 
    389396      IF ( ASSOCIATED(first_berg) ) THEN 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    48    !! $Id:$ 
     48   !! $Id$ 
    4949   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5050   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90

    • Property svn:keywords set to Id
    r3631 r5350  
    3131   PUBLIC   icb_thm ! routine called in icbstp.F90 module 
    3232 
     33   !! $Id$ 
    3334CONTAINS 
    3435 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90

    • Property svn:keywords set to Id
    r3614 r5350  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    46    !! $Id:$ 
     46   !! $Id$ 
    4747   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    5151   !!---------------------------------------------------------------------- 
    5252   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    53    !! $Id:$ 
     53   !! $Id$ 
    5454   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5555   !!------------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5342 r5350  
    2626   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename 
    2727   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input) 
     28   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory 
    2829   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output) 
     30   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory 
    2931   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file 
     32   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F) 
    3033   INTEGER       ::   nn_no            !: job number 
    3134   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2) 
    … …  
    3841   INTEGER       ::   nn_write         !: model standard output frequency 
    3942   INTEGER       ::   nn_stock         !: restart file frequency 
     43   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times 
    4044   LOGICAL       ::   ln_dimgnnn       !: type of dimgout. (F): 1 file for all proc 
    4145                                                       !:                  (T): 1 file per proc 
    … …  
    7983   INTEGER       ::   nwrite                      !: model standard output frequency 
    8084   INTEGER       ::   nstock                      !: restart file frequency 
     85   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times 
    8186 
    8287   !!---------------------------------------------------------------------- 
    … …  
    8691   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    8792   INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write) 
     93   INTEGER ::   nrst_lst              !: number of restart to output next 
    8894 
    8995   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5342 r5350  
    14671467      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 
    14681468      CALL set_mooring( zlonpira, zlatpira ) 
     1469 
     1470      ! diaptr : zonal mean  
     1471      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1472      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1473      CALL iom_update_file_name('ptr') 
     1474      ! 
    14691475       
    14701476   END SUBROUTINE set_xmlatt 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r4689 r5350  
    6161      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    6262 
    63       CHARACTER(LEN=100) ::   clinfo           ! info character 
    64       CHARACTER(LEN=100) ::   cltmp            ! temporary character 
     63      CHARACTER(LEN=256) ::   clinfo           ! info character 
     64      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
    6565      INTEGER            ::   iln              ! lengths of character 
    6666      INTEGER            ::   istop            ! temporary storage of nstop 
    … …  
    393393      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size   
    394394      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    395       CHARACTER(LEN=100)    :: clinfo               ! info character 
     395      CHARACTER(LEN=256)    :: clinfo               ! info character 
    396396      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character 
    397397      INTEGER               :: if90id               ! nf90 file identifier 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4990 r5350  
    5757      !! 
    5858      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    59       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     59      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name 
     60      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file 
    6061      !!---------------------------------------------------------------------- 
    6162      ! 
    6263      IF( kt == nit000 ) THEN   ! default definitions 
    6364         lrst_oce = .FALSE.    
    64          nitrst = nitend 
    65       ENDIF 
    66       IF( MOD( kt - 1, nstock ) == 0 ) THEN    
     65         IF( ln_rst_list ) THEN 
     66            nrst_lst = 1 
     67            nitrst = nstocklist( nrst_lst ) 
     68         ELSE 
     69            nitrst = nitend 
     70         ENDIF 
     71      ENDIF 
     72 
     73      ! frequency-based restart dumping (nn_stock) 
     74      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN    
    6775         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    6876         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    … …  
    7381      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 
    7482      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    75          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    76          IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    77          ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    78          ENDIF 
    79          ! create the file 
    80          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 
    81          IF(lwp) THEN 
    82             WRITE(numout,*) 
    83             SELECT CASE ( jprstlib ) 
    84             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname 
    85             CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname 
    86             END SELECT 
    87             IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
    88             IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
    89             ELSE                          ;   WRITE(numout,*) '             kt = '             , kt 
     83         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
     84            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     85            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     86            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    9087            ENDIF 
    91          ENDIF 
    92          ! 
    93          CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
    94          lrst_oce = .TRUE. 
     88            ! create the file 
     89            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 
     90            clpath = TRIM(cn_ocerst_outdir) 
     91            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     92            IF(lwp) THEN 
     93               WRITE(numout,*) 
     94               SELECT CASE ( jprstlib ) 
     95               CASE ( jprstdimg )   ;   WRITE(numout,*)                            & 
     96                   '             open ocean restart binary file: ',TRIM(clpath)//clname 
     97               CASE DEFAULT         ;   WRITE(numout,*)                            & 
     98                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname 
     99               END SELECT 
     100               IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
     101               IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
     102               ELSE                          ;   WRITE(numout,*) '             kt = '             , kt 
     103               ENDIF 
     104            ENDIF 
     105            ! 
     106            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
     107            lrst_oce = .TRUE. 
     108         ENDIF 
    95109      ENDIF 
    96110      ! 
    … …  
    142156!!gm  not sure what to do here   ===>>>  ask to Sebastian 
    143157         lrst_oce = .FALSE. 
     158            IF( ln_rst_list ) THEN 
     159               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
     160               nitrst = nstocklist( nrst_lst ) 
     161            ENDIF 
     162            lrst_oce = .FALSE. 
    144163      ENDIF 
    145164      ! 
    … …  
    156175      !!                the file has already been opened 
    157176      !!---------------------------------------------------------------------- 
    158       INTEGER  ::   jlibalt = jprstlib 
    159       LOGICAL  ::   llok 
     177      INTEGER        ::   jlibalt = jprstlib 
     178      LOGICAL        ::   llok 
     179      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file 
    160180      !!---------------------------------------------------------------------- 
    161181      ! 
    … …  
    171191         ENDIF 
    172192 
     193         clpath = TRIM(cn_ocerst_indir) 
     194         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    173195         IF ( jprstlib == jprstdimg ) THEN 
    174196           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    175197           ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90 
    176            INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 
     198           INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 
    177199           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    178200         ENDIF 
    179          CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt ) 
     201         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 
    180202      ENDIF 
    181203   END SUBROUTINE rst_read_open 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90

    • Property svn:keywords set to Id
    r3634 r5350  
    3131   !!---------------------------------------------------------------------- 
    3232   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    33    !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z  $ 
     33   !! $Id$ 
    3434   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3535   !!---------------------------------------------------------------------- 
    … …  
    5151   !!---------------------------------------------------------------------- 
    5252   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    53    !! $Id: ldfdyn_c3d.h90 1581 2009-08-05 14:53:12Z smasson $  
     53   !! $Id$  
    5454   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5555   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90

    • Property svn:keywords set to Id
    r3634 r5350  
    3131   !!---------------------------------------------------------------------- 
    3232   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    33    !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z  $ 
     33   !! $Id$ 
    3434   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3535   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90

    r2715 r5350  
    2424      &   greg2jul            ! Convert date to relative time  
    2525   
     26   !! $Id$ 
    2627CONTAINS 
    2728  

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90

    • Property svn:keywords set to Id
    r4230 r5350  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    43    !! $Id: module_example 1146 2008-06-25 11:42:56Z rblod $  
     43   !! $Id$  
    4444   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/OPA 4.0 , NEMO Consortium (2011)  
    45    !! $Id: $ 
     45   !! $Id$ 
    4646   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4747   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    48    !! $Id: sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo $ 
     48   !! $Id$ 
    4949   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5050   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5166 r5350  
    11991199            ENDDO 
    12001200         ELSE 
     1201            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12011202            DO jl=1,jpl 
    1202                qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12031203               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12041204            ENDDO 
    … …  
    12581258            ENDDO 
    12591259         ELSE 
     1260            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12601261            DO jl=1,jpl 
    1261                qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12621262               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12631263            ENDDO 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    • Property svn:keywords set to Id
    r5133 r5350  
    9696#  include "domzgr_substitute.h90" 
    9797 
     98   !! $Id$ 
    9899CONTAINS 
    99100 
    … …  
    10951096   !!   Default option           Dummy module         NO CICE sea-ice model 
    10961097   !!---------------------------------------------------------------------- 
     1098   !! $Id$ 
    10971099CONTAINS 
    10981100 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5128 r5350  
    184184         numit = numit + nn_fsbc                     ! Ice model time step 
    185185         !                                                    
    186          CALL sbc_lim_update                ! Store previous ice values 
     186         CALL sbc_lim_bef                   ! Store previous ice values 
    187187 
    188188         CALL sbc_lim_diag0                 ! set diag of mass, heat and salt fluxes to 0 
    … …  
    202202 
    203203#if defined key_bdy 
    204             CALL lim_var_glo2eqv 
    205204            CALL bdy_ice_lim( kt )         ! bdy ice thermo  
    206             CALL lim_var_zapsmall 
    207             CALL lim_var_agg(1) 
    208205            IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    209206#endif 
    … …  
    212209         ENDIF 
    213210          
    214          CALL sbc_lim_update                ! Store previous ice values 
     211         CALL sbc_lim_bef                  ! Store previous ice values 
    215212  
    216213         ! ---------------------------------------------- 
    217214         ! ice thermodynamics 
    218215         ! ---------------------------------------------- 
    219          CALL lim_var_glo2eqv 
    220216         CALL lim_var_agg(1) 
    221217          
    … …  
    248244         ! 
    249245         IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file  
    250          CALL lim_var_glo2eqv                       ! ??? 
    251          ! 
    252          IF( ln_icectl )   CALL lim_ctl( kt )        ! alerts in case of model crash 
     246         ! 
     247         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
    253248         ! 
    254249         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    … …  
    351346      !!------------------------------------------------------------------- 
    352347      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    353       NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_out,   & 
     348      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
    354349         &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
    355350      !!------------------------------------------------------------------- 
    … …  
    389384      r1_nlay_s = 1._wp / REAL( nlay_s, wp ) 
    390385      ! 
     386#if defined key_bdy 
     387      IF( lwp .AND. ln_limdiahsb )  CALL ctl_warn('online conservation check activated but it does not work with BDY') 
     388#endif 
     389      ! 
    391390   END SUBROUTINE ice_run 
    392391 
    … …  
    555554   END SUBROUTINE ice_lim_flx 
    556555 
    557    SUBROUTINE sbc_lim_update 
    558       !!---------------------------------------------------------------------- 
    559       !!                  ***  ROUTINE sbc_lim_update  *** 
     556   SUBROUTINE sbc_lim_bef 
     557      !!---------------------------------------------------------------------- 
     558      !!                  ***  ROUTINE sbc_lim_bef  *** 
    560559      !! 
    561560      !! ** purpose :  store ice variables at "before" time step  
    … …  
    571570      v_ice_b(:,:)     = v_ice(:,:) 
    572571       
    573    END SUBROUTINE sbc_lim_update 
     572   END SUBROUTINE sbc_lim_bef 
    574573 
    575574   SUBROUTINE sbc_lim_diag0 
    … …  
    602601      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
    603602      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
     603      hfx_err_dif(:,:) = 0._wp   ; 
    604604 
    605605      afx_tot(:,:) = 0._wp   ; 
    606606      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
    607607 
    608       diag_heat_dhc(:,:) = 0._wp ; 
     608      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ; 
     609      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ; 
    609610       
    610611   END SUBROUTINE sbc_lim_diag0 
    … …  
    635636 
    636637      fice_ice_ave (:,:) = 0.0_wp 
    637       WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
     638      WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
    638639 
    639640   END FUNCTION fice_ice_ave 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    • Property svn:keywords set to Id
    r5120 r5350  
    8080   !!---------------------------------------------------------------------- 
    8181   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    82    !! $Id: sbcice_if.F90 1730 2009-11-16 14:34:19Z smasson $ 
     82   !! $Id$ 
    8383   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8484   !!---------------------------------------------------------------------- 
    … …  
    561561      CALL iom_put('isfgammat', zgammat2d) 
    562562      CALL iom_put('isfgammas', zgammas2d) 
    563          ! 
    564       !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf  ) 
     563      ! 
    565564      CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d ) 
    566565      ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    38    !! $Id: $ 
     38   !! $Id$ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OPA 4.0 , NEMO Consortium (2011)  
    41    !! $Id: $ 
     41   !! $Id$ 
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    37    !! $Id:$  
     37   !! $Id$  
    3838   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    38    !! $Id: $ 
     38   !! $Id$ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 
    … …  
    8080          END DO 
    8181       END DO 
     82       !        
     83       ! Ensure that tidal components have been set in namelist_cfg 
     84       IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 
    8285       ! 
    8386       IF(lwp) THEN 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    28    !! $Id: sbcfwb.F90 3625 2012-11-21 13:19:18Z acc $ 
     28   !! $Id$ 
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r4990 r5350  
    4747   USE lbclnk         ! ocean lateral boundary conditions 
    4848   USE timing          ! Timing 
     49   USE stopar          ! Stochastic T/S fluctuations 
     50   USE stopts          ! Stochastic T/S fluctuations 
    4951 
    5052   IMPLICIT NONE 
    … …  
    313315      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    314316      ! 
    315       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    316       REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
    317       REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     317      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     318      INTEGER  ::   jdof 
     319      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     320      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     321      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
    318322      !!---------------------------------------------------------------------- 
    319323      ! 
    … …  
    324328      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    325329         ! 
    326          DO jk = 1, jpkm1 
    327             DO jj = 1, jpj 
    328                DO ji = 1, jpi 
    329                   ! 
    330                   zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    331                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    332                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    333                   ztm = tmask(ji,jj,jk)                                         ! tmask 
    334                   ! 
    335                   zn3 = EOS013*zt   & 
    336                      &   + EOS103*zs+EOS003 
    337                      ! 
    338                   zn2 = (EOS022*zt   & 
    339                      &   + EOS112*zs+EOS012)*zt   & 
    340                      &   + (EOS202*zs+EOS102)*zs+EOS002 
    341                      ! 
    342                   zn1 = (((EOS041*zt   & 
    343                      &   + EOS131*zs+EOS031)*zt   & 
    344                      &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    345                      &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    346                      &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    347                      ! 
    348                   zn0 = (((((EOS060*zt   & 
    349                      &   + EOS150*zs+EOS050)*zt   & 
    350                      &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    351                      &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    352                      &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    353                      &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    354                      &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    355                      ! 
    356                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    357                   ! 
    358                   prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
    359                   ! 
    360                   prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     330         ! Stochastic equation of state 
     331         IF ( ln_sto_eos ) THEN 
     332            ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
     333            ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
     334            ALLOCATE(zsign(1:2*nn_sto_eos)) 
     335            DO jsmp = 1, 2*nn_sto_eos, 2 
     336              zsign(jsmp)   = 1._wp 
     337              zsign(jsmp+1) = -1._wp 
     338            END DO 
     339            ! 
     340            DO jk = 1, jpkm1 
     341               DO jj = 1, jpj 
     342                  DO ji = 1, jpi 
     343                     ! 
     344                     ! compute density (2*nn_sto_eos) times: 
     345                     ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
     346                     ! (2) for t-dt, s-ds (with the opposite fluctuation) 
     347                     DO jsmp = 1, nn_sto_eos*2 
     348                        jdof   = (jsmp + 1) / 2 
     349                        zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     350                        zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
     351                        zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
     352                        zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
     353                        ztm    = tmask(ji,jj,jk)                                         ! tmask 
     354                        ! 
     355                        zn3 = EOS013*zt   & 
     356                           &   + EOS103*zs+EOS003 
     357                           ! 
     358                        zn2 = (EOS022*zt   & 
     359                           &   + EOS112*zs+EOS012)*zt   & 
     360                           &   + (EOS202*zs+EOS102)*zs+EOS002 
     361                           ! 
     362                        zn1 = (((EOS041*zt   & 
     363                           &   + EOS131*zs+EOS031)*zt   & 
     364                           &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     365                           &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     366                           &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     367                           ! 
     368                        zn0_sto(jsmp) = (((((EOS060*zt   & 
     369                           &   + EOS150*zs+EOS050)*zt   & 
     370                           &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     371                           &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     372                           &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     373                           &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     374                           &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     375                           ! 
     376                        zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
     377                     END DO 
     378                     ! 
     379                     ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
     380                     prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
     381                     DO jsmp = 1, nn_sto_eos*2 
     382                        prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
     383                        ! 
     384                        prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rau0 - 1._wp  )   ! density anomaly (masked) 
     385                     END DO 
     386                     prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
     387                     prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
     388                  END DO 
    361389               END DO 
    362390            END DO 
    363          END DO 
    364          ! 
     391            DEALLOCATE(zn0_sto,zn_sto,zsign) 
     392         ! Non-stochastic equation of state 
     393         ELSE 
     394            DO jk = 1, jpkm1 
     395               DO jj = 1, jpj 
     396                  DO ji = 1, jpi 
     397                     ! 
     398                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     399                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     400                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     401                     ztm = tmask(ji,jj,jk)                                         ! tmask 
     402                     ! 
     403                     zn3 = EOS013*zt   & 
     404                        &   + EOS103*zs+EOS003 
     405                        ! 
     406                     zn2 = (EOS022*zt   & 
     407                        &   + EOS112*zs+EOS012)*zt   & 
     408                        &   + (EOS202*zs+EOS102)*zs+EOS002 
     409                        ! 
     410                     zn1 = (((EOS041*zt   & 
     411                        &   + EOS131*zs+EOS031)*zt   & 
     412                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     413                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     414                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     415                        ! 
     416                     zn0 = (((((EOS060*zt   & 
     417                        &   + EOS150*zs+EOS050)*zt   & 
     418                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     419                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     420                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     421                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     422                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     423                        ! 
     424                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     425                     ! 
     426                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     427                     ! 
     428                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     429                  END DO 
     430               END DO 
     431            END DO 
     432         ENDIF 
     433          
    365434      CASE( 1 )                !==  simplified EOS  ==! 
    366435         ! 
    … …  
    15891658      END SELECT 
    15901659      ! 
     1660      rau0_rcp    = rau0 * rcp  
    15911661      r1_rau0     = 1._wp / rau0 
    15921662      r1_rcp      = 1._wp / rcp 
    1593       r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     1663      r1_rau0_rcp = 1._wp / rau0_rcp  
    15941664      ! 
    15951665      IF(lwp) WRITE(numout,*) 
    … …  
    15971667      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
    15981668      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1669      IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp 
    15991670      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
    16001671      ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5130 r5350  
    2626   USE cla             ! cross land advection      (cla_traadv     routine) 
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   ! 
    2829   USE in_out_manager  ! I/O manager 
    2930   USE iom             ! I/O module 
    … …  
    3334   USE timing          ! Timing 
    3435   USE sbc_oce 
     36   USE diaptr          ! Poleward heat transport  
    3537 
    3638 
    … …  
    111113      ! 
    112114      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary) 
     115      ! 
    113116      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport       
    114117      CALL iom_put( "vocetr_eff", zvn ) 
    115118      CALL iom_put( "wocetr_eff", zwn ) 
    116  
     119      ! 
     120      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF  
     121      ! 
     122    
    117123      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    118       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
    119       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
    120       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL  
    121       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
    122       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
    123       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
    124       CASE ( 7 )   ;   CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS 
     124      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     125      CASE ( 2 )   ;    CALL tra_adv_tvd    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
     126      CASE ( 3 )   ;    CALL tra_adv_muscl  ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL  
     127      CASE ( 4 )   ;    CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
     128      CASE ( 5 )   ;    CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
     129      CASE ( 6 )   ;    CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
     130      CASE ( 7 )   ;    CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS 
    125131      ! 
    126132      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r4990 r5350  
    279279         END IF 
    280280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    281          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    282            IF( jn == jp_tem )   htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    283            IF( jn == jp_sal )   str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     281         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     282           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     283           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    284284         ENDIF 
    285285         ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    • Property svn:keywords set to Id
    r4835 r5350  
    5353   !!---------------------------------------------------------------------- 
    5454   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    55    !! $Id:$ 
     55   !! $Id$ 
    5656   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5757   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r4990 r5350  
    2121   USE trdtra         ! tracers trends manager 
    2222   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    23    USE sbcrnf          ! river runoffs 
     23   USE sbcrnf         ! river runoffs 
    2424   USE diaptr         ! poleward transport diagnostics 
    2525   ! 
    … …  
    219219         END IF 
    220220         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    221          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    222             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    223             IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     221         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     222            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     223            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    224224         ENDIF 
    225225 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r4990 r5350  
    200200 
    201201         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    202          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    203             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    204             IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     202         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     203            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     204            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    205205         ENDIF 
    206206 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r4990 r5350  
    355355         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    356356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    357          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    358            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    359            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     357         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     358           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     359           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    360360         ENDIF 
    361361         ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r5120 r5350  
    193193         END IF 
    194194         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    195          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    196            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    197            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     195         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     196           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     197           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    198198         ENDIF 
    199199 
    … …  
    264264         END IF 
    265265         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    266          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    267            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    268            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     266         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     267           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     268           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    269269         ENDIF 
    270270         ! 
    … …  
    430430         END IF 
    431431         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    432          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    433            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    434            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     432         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     433           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     434           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    435435         ENDIF 
    436436 
    … …  
    556556         END IF 
    557557         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    558          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    559            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    560            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     558         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     559           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     560           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    561561         ENDIF 
    562562         ! 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r4990 r5350  
    177177         END IF 
    178178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    180             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( ztv(:,:,:) ) 
    181             IF( jn == jp_sal )  str_adv(:) = ptr_vj( ztv(:,:,:) ) 
     179         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     180            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) ) 
     181            IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) ) 
    182182         ENDIF 
    183183          

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r4990 r5350  
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    44    !! $Id $  
     44   !! $Id$ 
    4545   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r5120 r5350  
    173173         !                                                 
    174174         ! "zonal" mean lateral diffusive heat and salt transport 
    175          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    176            IF( jn == jp_tem )  htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    177            IF( jn == jp_sal )  str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     175         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     176           IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
     177           IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    178178         ENDIF 
    179179         !                                                ! =========== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r4292 r5350  
    247247         !                                                ! =============== 
    248248         ! "Poleward" diffusive heat or salt transport 
    249          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     249         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 
    250250            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    251             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    252             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     251            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     252            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    253253         ENDIF 
    254254 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5120 r5350  
    2828   USE in_out_manager  ! I/O manager 
    2929   USE iom             ! I/O library 
    30 #if defined key_diaar5 
    3130   USE phycst          ! physical constants 
    3231   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33 #endif 
    3432   USE wrk_nemo        ! Memory Allocation 
    3533   USE timing          ! Timing 
    … …  
    110108      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    111109      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    112 #if defined key_diaar5 
    113       REAL(wp)                         ::   zztmp               ! local scalar 
    114 #endif 
    115110      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    116111      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
    … …  
    240235         ! 
    241236         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    242          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     237         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    243238            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    244             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    245             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     239            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     240            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    246241         ENDIF 
    247242  
    248 #if defined key_diaar5 
    249          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    250             z2d(:,:) = 0._wp  
    251             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    252             zztmp = -1.0_wp * rau0 * rcp 
    253             DO jk = 1, jpkm1 
    254                DO jj = 2, jpjm1 
    255                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    256                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     243         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     244           ! 
     245           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     246               z2d(:,:) = 0._wp  
     247               DO jk = 1, jpkm1 
     248                  DO jj = 2, jpjm1 
     249                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     250                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     251                     END DO 
    257252                  END DO 
    258253               END DO 
    259             END DO 
    260             z2d(:,:) = zztmp * z2d(:,:) 
    261             CALL lbc_lnk( z2d, 'U', -1. ) 
    262             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    263             z2d(:,:) = 0._wp  
    264             DO jk = 1, jpkm1 
    265                DO jj = 2, jpjm1 
    266                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    267                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     254               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     255               CALL lbc_lnk( z2d, 'U', -1. ) 
     256               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     257               ! 
     258               z2d(:,:) = 0._wp  
     259               DO jk = 1, jpkm1 
     260                  DO jj = 2, jpjm1 
     261                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     262                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     263                     END DO 
    268264                  END DO 
    269265               END DO 
    270             END DO 
    271             z2d(:,:) = zztmp * z2d(:,:) 
    272             CALL lbc_lnk( z2d, 'V', -1. ) 
    273             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    274          END IF 
    275 #endif 
     266               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     267               CALL lbc_lnk( z2d, 'V', -1. ) 
     268               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     269            END IF 
     270            ! 
     271         ENDIF 
    276272 
    277273         !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r4990 r5350  
    113113      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt 
    114114      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115 #if defined key_diaar5 
    116       REAL(wp) ::   zztmp              ! local scalar 
    117 #endif 
    118115      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d 
    119116      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw  
    … …  
    207204      END DO 
    208205      ! 
    209 #if defined key_iomput 
    210       IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
    211          CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
    212          DO jk=1,jpkm1 
    213             zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    214          END DO 
    215          zw3d(:,:,jpk) = 0._wp 
    216          CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
    217  
    218          DO jk=1,jpk-1 
    219             zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    220          END DO 
    221          zw3d(:,:,jpk) = 0._wp 
    222          CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
    223  
    224          DO jk=1,jpk-1 
    225             DO jj = 2, jpjm1 
    226                DO ji = fs_2, fs_jpim1  ! vector opt. 
    227                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
    228                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    229                END DO 
    230             END DO 
    231          END DO 
    232          zw3d(:,:,jpk) = 0._wp 
    233          CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
    234          CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     206      IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN 
     207         ! 
     208         IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
     209            CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
     210            DO jk=1,jpkm1 
     211               zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
     212            END DO 
     213            zw3d(:,:,jpk) = 0._wp 
     214            CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
     215 
     216            DO jk=1,jpk-1 
     217               zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
     218            END DO 
     219            zw3d(:,:,jpk) = 0._wp 
     220            CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
     221 
     222            DO jk=1,jpk-1 
     223               DO jj = 2, jpjm1 
     224                  DO ji = fs_2, fs_jpim1  ! vector opt. 
     225                     zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
     226                          &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
     227                  END DO 
     228               END DO 
     229            END DO 
     230            zw3d(:,:,jpk) = 0._wp 
     231            CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
     232            CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     233         ENDIF 
     234         ! 
    235235      ENDIF 
    236 #endif 
    237236      !                                                          ! =========== 
    238237      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    387386         ! 
    388387         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    389          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    390             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names 
    391             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     388         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     389            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
     390            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    392391         ENDIF 
    393392 
    394 #if defined key_diaar5 
    395          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    396             z2d(:,:) = 0._wp 
    397             zztmp = rau0 * rcp 
    398             DO jk = 1, jpkm1 
    399                DO jj = 2, jpjm1 
    400                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    401                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
    402                   END DO 
    403                END DO 
    404             END DO 
    405             z2d(:,:) = zztmp * z2d(:,:) 
    406             CALL lbc_lnk( z2d, 'U', -1. ) 
    407             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    408             z2d(:,:) = 0._wp 
    409             DO jk = 1, jpkm1 
    410                DO jj = 2, jpjm1 
    411                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    412                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
    413                   END DO 
    414                END DO 
    415             END DO 
    416             z2d(:,:) = zztmp * z2d(:,:) 
    417             CALL lbc_lnk( z2d, 'V', -1. ) 
    418             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in j-direction 
    419          END IF 
    420 #endif 
     393         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     394           ! 
     395           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     396               z2d(:,:) = 0._wp  
     397               DO jk = 1, jpkm1 
     398                  DO jj = 2, jpjm1 
     399                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     400                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     401                     END DO 
     402                  END DO 
     403               END DO 
     404               z2d(:,:) = rau0_rcp * z2d(:,:)  
     405               CALL lbc_lnk( z2d, 'U', -1. ) 
     406               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     407               ! 
     408               z2d(:,:) = 0._wp  
     409               DO jk = 1, jpkm1 
     410                  DO jj = 2, jpjm1 
     411                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     412                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     413                     END DO 
     414                  END DO 
     415               END DO 
     416               z2d(:,:) = rau0_rcp * z2d(:,:)      
     417               CALL lbc_lnk( z2d, 'V', -1. ) 
     418               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     419            END IF 
     420            ! 
     421         ENDIF 
    421422         ! 
    422423      END DO 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r5120 r5350  
    154154         ! 
    155155         ! "Poleward" diffusive heat or salt transports 
    156          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    157             IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    158             IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     156         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     157            IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
     158            IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    159159         ENDIF 
    160160         !                                                  ! ================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    7676   !!---------------------------------------------------------------------- 
    7777   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    78    !! $Id: trd_oce.F90 3318 2012-02-25 15:50:01Z gm $ 
     78   !! $Id$ 
    7979   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8080   !!====================================================================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    42    !! $Id: trddyn.F90 3325 2012-03-12 14:44:43Z gm $ 
     42   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    58    !! $Id: trdglo.F90 3325 2012-03-12 14:44:43Z gm $ 
     58   !! $Id$ 
    5959   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6060   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    3030   !!---------------------------------------------------------------------- 
    3131   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    32    !! $Id: trdini.F90 3329 2012-03-16 12:22:15Z gm $ 
     32   !! $Id$ 
    3333   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    46    !! $Id: trdken.F90 3329 2012-03-16 12:22:15Z gm $ 
     46   !! $Id$ 
    4747   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    7777   !!---------------------------------------------------------------------- 
    7878   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    79    !! $Id: trdmxl.F90 3318 2012-02-25 15:50:01Z gm $  
     79   !! $Id$  
    8080   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8181   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    8383   !!---------------------------------------------------------------------- 
    8484   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    85    !! $Id: $  
     85   !! $Id$  
    8686   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8787   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    2727   !!--------------------------------------------------------------------------------- 
    2828   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    29    !! $Id: $  
     29   !! $Id$ 
    3030   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3131   !!--------------------------------------------------------------------------------- 
    … …  
    4343      INTEGER ::   jk                 ! loop indice 
    4444      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    45       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     45      CHARACTER(LEN=50)   ::   clname   ! output restart file name 
     46      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    4647      !!-------------------------------------------------------------------------------- 
    4748 
    … …  
    5657         ! create the file 
    5758         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_out) 
     59         clpath = TRIM(cn_ocerst_outdir) 
     60         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    5861         IF(lwp) THEN 
    5962            WRITE(numout,*) 
    … …  
    6770         ENDIF 
    6871 
    69          CALL iom_open( clname, nummxlw, ldwrt = .TRUE., kiolib = jprstlib ) 
     72         CALL iom_open( TRIM(clpath)//TRIM(clname), nummxlw, ldwrt = .TRUE., kiolib = jprstlib ) 
    7073      ENDIF 
    7174 
    … …  
    133136      INTEGER ::   jlibalt = jprstlib 
    134137      LOGICAL ::   llok 
     138      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    135139      !!----------------------------------------------------------------------------- 
    136140 
    … …  
    140144         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~' 
    141145      ENDIF 
     146 
     147      clpath = TRIM(cn_ocerst_indir) 
     148      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     149 
    142150      IF ( jprstlib == jprstdimg ) THEN 
    143151         ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    144152         ! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90 
    145          INQUIRE( FILE = TRIM(cn_trdrst_in)//'.nc', EXIST = llok ) 
     153         INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_in)//'.nc', EXIST = llok ) 
    146154         IF ( llok ) THEN   ;   jlibalt = jpnf90    
    147155         ELSE               ;   jlibalt = jprstlib    
    … …  
    149157      ENDIF 
    150158 
    151       CALL iom_open( cn_trdrst_in, inum, kiolib = jlibalt )  
     159      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt )  
    152160 
    153161      IF( ln_trdmxl_instant ) THEN  

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    43    !! $Id: trdtra.F90 3318 2012-02-25 15:50:01Z gm $ 
     43   !! $Id$ 
    4444   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    1818   !!---------------------------------------------------------------------- 
    1919   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    20    !! $Id: trdtrc.F90 2715 2011-03-30 15:58:35Z rblod $ 
     20   !! $Id$ 
    2121   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2222   !!====================================================================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r5120 r5350  
    171171            END DO 
    172172         END DO 
     173         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
     174 
    173175         IF ( ln_isfcav ) THEN 
    174176            DO jj = 2, jpjm1 
    175177               DO ji = 2, jpim1 
    176178                  ! (ISF) ======================================================================== 
    177                   ikbu = miku(ji,jj)         ! ocean bottom level at u- and v-points  
    178                   ikbv = mikv(ji,jj)         ! (deepest ocean u- and v-points) 
     179                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points  
     180                  ikbv = mikv(ji,jj)         ! (1st wet ocean u- and v-points) 
    179181                  ! 
    180182                  zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     & 
    … …  
    183185                     &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  ) 
    184186              ! 
    185                   zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 ) 
    186                   zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 ) 
     187                  zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 ) 
     188                  zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 ) 
    187189              ! 
    188190                  tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) * zecu * (1._wp - umask(ji,jj,1)) 
    … …  
    202204               END DO 
    203205            END DO 
    204          END IF 
    205          ! 
    206          CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
     206            CALL lbc_lnk( tfrua, 'U', 1. )   ;   CALL lbc_lnk( tfrva, 'V', 1. )      ! Lateral boundary condition 
     207         END IF 
     208         ! 
    207209         ! 
    208210         IF(ln_ctl)   CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  - u: ', mask1=umask,        & 
    … …  
    277279            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien 
    278280         ENDIF 
    279          IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_bfri1 
    280          IF( ln_tfr2d ) THEN 
    281             IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
    282             IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
    283          ENDIF 
     281         IF ( ln_isfcav ) THEN 
     282            IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_tfri1 
     283            IF( ln_tfr2d ) THEN 
     284               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
     285               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
     286            ENDIF 
     287         END IF 
    284288         ! 
    285289         IF(ln_bfr2d) THEN 
    … …  
    295299         bfrua(:,:) = - bfrcoef2d(:,:) 
    296300         bfrva(:,:) = - bfrcoef2d(:,:) 
     301         ! 
     302         IF ( ln_isfcav ) THEN 
     303            IF(ln_tfr2d) THEN 
     304               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 
     305               CALL iom_open('tfr_coef.nc',inum) 
     306               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 
     307               CALL iom_close(inum) 
     308               tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
     309            ELSE 
     310               tfrcoef2d(:,:) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable 
     311            ENDIF 
     312            ! 
     313            tfrua(:,:) = - tfrcoef2d(:,:) 
     314            tfrva(:,:) = - tfrcoef2d(:,:) 
     315         END IF 
    297316         ! 
    298317      CASE( 2 ) 
    … …  
    311330            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien 
    312331         ENDIF 
    313          IF(lwp) WRITE(numout,*) '      quadratic top    friction' 
    314          IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri2  = ', rn_tfri2 
    315          IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max 
    316          IF(lwp) WRITE(numout,*) '      background tke   rn_tfeb2  = ', rn_tfeb2 
    317          IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d = ', ln_loglayer 
    318          IF(lwp) WRITE(numout,*) '      bottom roughness  rn_tfrz0 [m] = ', rn_tfrz0 
    319          IF( rn_tfrz0<=0.e0 ) THEN 
    320             WRITE(ctmp1,*) '      bottom roughness must be strictly positive' 
    321             CALL ctl_stop( ctmp1 ) 
    322          ENDIF 
    323          IF( ln_tfr2d ) THEN 
    324             IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
    325             IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
    326          ENDIF 
     332         IF ( ln_isfcav ) THEN 
     333            IF(lwp) WRITE(numout,*) '      quadratic top    friction' 
     334            IF(lwp) WRITE(numout,*) '      friction coef.    rn_tfri2     = ', rn_tfri2 
     335            IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max 
     336            IF(lwp) WRITE(numout,*) '      background tke    rn_tfeb2     = ', rn_tfeb2 
     337            IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d     = ', ln_loglayer 
     338            IF(lwp) WRITE(numout,*) '      top roughness     rn_tfrz0 [m] = ', rn_tfrz0 
     339            IF( rn_tfrz0<=0.e0 ) THEN 
     340               WRITE(ctmp1,*) '      top roughness must be strictly positive' 
     341               CALL ctl_stop( ctmp1 ) 
     342            ENDIF 
     343            IF( ln_tfr2d ) THEN 
     344               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
     345               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
     346            ENDIF 
     347         END IF 
    327348         ! 
    328349         IF(ln_bfr2d) THEN 
    … …  
    336357            bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable 
    337358         ENDIF 
     359          
     360         IF ( ln_isfcav ) THEN 
     361            IF(ln_tfr2d) THEN 
     362               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 
     363               CALL iom_open('tfr_coef.nc',inum) 
     364               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 
     365               CALL iom_close(inum) 
     366               ! 
     367               tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
     368            ELSE 
     369               tfrcoef2d(:,:) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable 
     370            ENDIF 
     371         END IF 
    338372         ! 
    339373         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 
    … …  
    346380               END DO 
    347381            END DO 
     382            IF ( ln_isfcav ) THEN 
     383               DO jj = 1, jpj 
     384                  DO ji = 1, jpi 
     385                     ikbt = mikt(ji,jj) 
     386                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 
     387                     tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 
     388                     tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max) 
     389                  END DO 
     390               END DO 
     391            END IF 
    348392         ENDIF 
    349393         ! 
    … …  
    398442             zminbfr = MIN(  zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) )  ) 
    399443             zmaxbfr = MAX(  zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) )  ) 
     444! (ISF) 
     445             IF ( ln_isfcav ) THEN 
     446                ikbu = miku(ji,jj)       ! 1st wet ocean level at u- and v-points 
     447                ikbv = mikv(ji,jj) 
     448                zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt 
     449                zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt 
     450                IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN 
     451                   IF( ln_ctl ) THEN 
     452                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu 
     453                      WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru 
     454                   ENDIF 
     455                   ictu = ictu + 1 
     456                ENDIF 
     457                IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN 
     458                   IF( ln_ctl ) THEN 
     459                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv 
     460                      WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv 
     461                   ENDIF 
     462                   ictv = ictv + 1 
     463                ENDIF 
     464                zmintfr = MIN(  zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) )  ) 
     465                zmaxtfr = MAX(  zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) )  ) 
     466             END IF 
     467! END ISF 
    400468         END DO 
    401469      END DO 
    … …  
    405473         CALL mpp_min( zminbfr ) 
    406474         CALL mpp_max( zmaxbfr ) 
     475         IF ( ln_isfcav) CALL mpp_min( zmintfr ) 
     476         IF ( ln_isfcav) CALL mpp_max( zmaxtfr ) 
    407477      ENDIF 
    408478      IF( .NOT.ln_bfrimp) THEN 
    409479      IF( lwp .AND. ictu + ictv > 0 ) THEN 
    410          WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points ' 
    411          WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points ' 
     480         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points ' 
     481         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points ' 
    412482         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr 
    413          WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 
    414          WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary' 
     483         IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 
     484         WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary' 
    415485      ENDIF 
    416486      ENDIF 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5123 r5350  
    8282   USE crsini          ! initialise grid coarsening utility 
    8383   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     84   USE stopar 
     85   USE stopts 
    8486 
    8587   IMPLICIT NONE 
    … …  
    432434      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection 
    433435                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     436                            CALL sto_par_init   ! Stochastic parametrization 
     437      IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations 
    434438      
    435439#if defined key_top 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5120 r5350  
    106106 
    107107      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     108      ! Update stochastic parameters and random T/S fluctuations 
     109      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     110                        CALL sto_par( kstp )          ! Stochastic parameters 
     111 
     112      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    108113      ! Ocean physics update                (ua, va, tsa used as workspace) 
    109114      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    145150      ! 
    146151      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
     152         IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations 
    147153                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
    148154         IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    … …  
    180186          ! Note that the computation of vertical velocity above, hence "after" sea level 
    181187          ! is necessary to compute momentum advection for the rhs of barotropic loop: 
     188            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
    182189                            CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
    183190            IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    … …  
    216223      ! diagnostics and outputs             (ua, va, tsa used as workspace) 
    217224      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    218       IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    219       IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    220       IF( .NOT. lk_cpl ) CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    221       IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics 
    222       IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    223       IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 
    224       IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
    225                          CALL dia_wri( kstp )         ! ocean model: outputs 
    226       ! 
    227       IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    228  
     225      IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats 
     226      IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
     227      IF( .NOT. lk_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     228      IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports 
     229      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag 
     230      IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis 
     231                            CALL dia_wri( kstp )         ! ocean model: outputs 
     232      ! 
     233      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    229234 
    230235#if defined key_top 
    … …  
    252257      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    253258                             CALL tra_ldf    ( kstp )       ! lateral mixing 
     259 
     260      IF( ln_diaptr      )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics 
     261 
    254262#if defined key_agrif 
    255263      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    … …  
    260268         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    261269                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     270            IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations 
    262271                             CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
    263272            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
    … …  
    270279      ELSE                                                  ! centered hpg  (eos then time stepping) 
    271280         IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case 
     281            IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations 
    272282                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
    273283         IF( ln_zps .AND. .NOT. ln_isfcav)                                   & 
    … …  
    338348                 CALL iom_close( numror )     ! close input  ocean restart file 
    339349         IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce 
    340          IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice     
     350         IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice 
    341351      ENDIF 
    342352      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4990 r5350  
    5353 
    5454   USE dynnxt           ! time-stepping                    (dyn_nxt routine) 
     55 
     56   USE stopar           ! Stochastic parametrization       (sto_par routine) 
     57   USE stopts  
    5558 
    5659   USE bdy_par          ! for lk_bdy 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    • Property svn:keywords set to Id
    r3294 r5350  
    123123   !!---------------------------------------------------------------------- 
    124124   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    125    !! $Id:$ 
     125   !! $Id$ 
    126126   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    127127   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    • Property svn:keywords set to Id
    r4162 r5350  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    47    !! $Id: daymod.F90 3294 2012-01-28 16:44:18Z rblod $ 
     47   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    7070   !!---------------------------------------------------------------------- 
    7171   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    72    !! $Id $ 
     72   !! $Id$ 
    7373   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7474   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    • Property svn:keywords set to Id
    r5120 r5350  
    6666   !!---------------------------------------------------------------------- 
    6767   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    68    !! $Id: nemogcm.F90 3294 2012-01-28 16:44:18Z rblod $ 
     68   !! $Id$ 
    6969   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7070   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    5757   !!---------------------------------------------------------------------- 
    5858   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    59    !! $Id: sbcssm.F90 3294 2012-01-28 16:44:18Z rblod $ 
     59   !! $Id$ 
    6060   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6161   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/step.F90

    • Property svn:keywords set to Id
    r4166 r5350  
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    48    !! $Id: step.F90 3294 2012-01-28 16:44:18Z rblod $ 
     48   !! $Id$ 
    4949   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5050   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/stpctl.F90

    • Property svn:keywords set to Id
    r3358 r5350  
    2828   !!---------------------------------------------------------------------- 
    2929   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    30    !! $Id: stpctl.F90 3294 2012-01-28 16:44:18Z rblod $ 
     30   !! $Id$ 
    3131   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3232   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r4996 r5350  
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    56    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
     56   !! $Id$  
    5757   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5858   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    • Property svn:keywords set to Id
    r4996 r5350  
    6363   !!---------------------------------------------------------------------- 
    6464   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    65    !! $Id: p2zbio.F90 3294 2012-01-28 16:44:18Z rblod $  
     65   !! $Id$  
    6666   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6767   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    • Property svn:keywords set to Id
    r4996 r5350  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    47    !! $Id: trcexp.F90 3294 2012-01-28 16:44:18Z rblod $  
     47   !! $Id$  
    4848   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    46    !! $Id: trcopt.F90 3294 2012-01-28 16:44:18Z rblod $  
     46   !! $Id$  
    4747   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    • Property svn:keywords set to Id
    r4996 r5350  
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    40    !! $Id: p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod $  
     40   !! $Id$  
    4141   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    34    !! $Id: p2zsms.F90 3294 2012-01-28 16:44:18Z rblod $  
     34   !! $Id$  
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    • Property svn:keywords set to Id
    r3557 r5350  
    168168   !!---------------------------------------------------------------------- 
    169169   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    170    !! $Id: p4zche.F90 3294 2012-01-28 16:44:18Z rblod $  
     170   !! $Id$  
    171171   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    172172   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    • Property svn:keywords set to Id
    r4996 r5350  
    6363   !!---------------------------------------------------------------------- 
    6464   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    65    !! $Id: p4zflx.F90 3294 2012-01-28 16:44:18Z rblod $  
     65   !! $Id$  
    6666   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6767   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    • Property svn:keywords set to Id
    r3446 r5350  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    28    !! $Id: p4zint.F90 3294 2012-01-28 16:44:18Z rblod $  
     28   !! $Id$  
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $  
     41   !! $Id$  
    4242   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    • Property svn:keywords set to Id
    r4996 r5350  
    8585   !!---------------------------------------------------------------------- 
    8686   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    87    !! $Header:$  
     87   !! $Id$  
    8888   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    8989   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    • Property svn:keywords set to Id
    r4996 r5350  
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    44    !! $Header:$  
     44   !! $Id$  
    4545   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    77   !!        !  06-12  (C. Ethe)  Orignal 
    88   !!---------------------------------------------------------------------- 
     9   !! $Id$ 
    910#if defined key_sed 
    1011   !! Domain characteristics 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    160160   INTEGER, PUBLIC ::  numsed = 27    ! units 
    161161 
     162   !! $Id$ 
    162163CONTAINS 
    163164 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2323   REAL(wp) :: eps = 1.e-13 
    2424 
     25   !! $Id$ 
    2526CONTAINS 
    2627 
    … …  
    438439   !! MODULE sedbtb  :   Dummy module  
    439440   !!====================================================================== 
     441   !! $Id$ 
    440442CONTAINS 
    441443   SUBROUTINE sed_adv( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    31    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $  
     31   !! $Id$  
    3232   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    1212 
    1313 
     14   !! $Id$ 
    1415CONTAINS 
    1516    
    … …  
    7778   !! MODULE sedbtb  :   Dummy module  
    7879   !!====================================================================== 
     80   !! $Id$ 
    7981CONTAINS 
    8082   SUBROUTINE sed_btb( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    163163   DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/ 
    164164 
     165   !! $Id$ 
    165166CONTAINS 
    166167 
    … …  
    559560   !! MODULE sedchem  :   Dummy module  
    560561   !!====================================================================== 
     562   !! $Id$ 
    561563CONTAINS 
    562564   SUBROUTINE sed_chem( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2323   !!---------------------------------------------------------------------- 
    2424 
     25   !! $Id$ 
    2526CONTAINS 
    2627 
    … …  
    188189   !! MODULE sedco3  :   Dummy module  
    189190   !!====================================================================== 
     191   !! $Id$ 
    190192CONTAINS 
    191193   SUBROUTINE sed_co3( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2020   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC ::  dens_mol_wgt  ! molecular density  
    2121 
     22   !! $Id$ 
    2223CONTAINS 
    2324    
    … …  
    530531   !! MODULE seddsr  :   Dummy module  
    531532   !!====================================================================== 
     533   !! $Id$ 
    532534CONTAINS 
    533535   SUBROUTINE sed_dsr ( kt ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2828#endif 
    2929 
     30   !! $Id$ 
    3031CONTAINS 
    3132 
    … …  
    268269   !! MODULE seddta  :   Dummy module  
    269270   !!====================================================================== 
     271   !! $Id$ 
    270272CONTAINS 
    271273   SUBROUTINE sed_dta ( kt ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90

    • Property svn:keywords set to Id
    r4292 r5350  
    5555   PUBLIC sed_init          ! routine called by opa.F90 
    5656 
     57   !! $Id$ 
    5758CONTAINS 
    5859 
    … …  
    856857   !!   Dummy module :                      NO Sediment model 
    857858   !!---------------------------------------------------------------------- 
     859   !! $Id$ 
    858860CONTAINS 
    859861   SUBROUTINE sed_ini              ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2222 
    2323 
     24   !! $Id$ 
    2425 CONTAINS 
    2526 
    … …  
    257258   !! MODULE sedmat  :   Dummy module  
    258259   !!====================================================================== 
     260   !! $Id$ 
    259261CONTAINS 
    260262   SUBROUTINE sed_mat         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    3636   REAL(wp)  :: src13ca   
    3737 
     38   !! $Id$ 
    3839CONTAINS 
    3940 
    … …  
    311312   !! MODULE sedmbc :   Dummy module  
    312313   !!====================================================================== 
     314   !! $Id$ 
    313315CONTAINS 
    314316   SUBROUTINE sed_mbc( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    1717   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag 
    1818 
     19   !! $Id$ 
    1920CONTAINS 
    2021 
    … …  
    4748   !!====================================================================== 
    4849   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag 
     50   !! $Id$ 
    4951CONTAINS 
    5052   SUBROUTINE sed_model( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2525    
    2626    
     27   !! $Id$ 
    2728CONTAINS 
    2829 
    … …  
    270271   !! MODULE sedrst :   Dummy module  
    271272   !!====================================================================== 
     273   !! $Id$ 
    272274CONTAINS 
    273275   SUBROUTINE sed_rst_read                      ! Empty routines 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    1212   PUBLIC sed_sfc 
    1313 
     14   !! $Id$ 
    1415CONTAINS 
    1516 
    … …  
    6768   !! MODULE sedsfc  :   Dummy module  
    6869   !!====================================================================== 
     70   !! $Id$ 
    6971CONTAINS 
    7072   SUBROUTINE sed_sfc ( kt ) 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2323   PUBLIC sed_stp  ! called by step.F90 
    2424 
     25   !! $Id$ 
    2526CONTAINS 
    2627 
    … …  
    6970   !! MODULE sedstp  :   Dummy module  
    7071   !!====================================================================== 
     72   !! $Id$ 
    7173CONTAINS 
    7274   SUBROUTINE sed_stp( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90

    • Property svn:keywords set to Id
    r3443 r5350  
    2525   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 
    2626 
     27   !! $Id$ 
    2728CONTAINS 
    2829 
    … …  
    264265   !! MODULE sedwri  :   Dummy module 
    265266   !!====================================================================== 
     267   !! $Id$ 
    266268CONTAINS 
    267269   SUBROUTINE sed_wri( kt )         ! Empty routine 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5102 r5350  
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    45    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
     45   !! $Id$  
    4646   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4747   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    7171   !!---------------------------------------------------------------------- 
    7272   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    73    !! $Header:  $  
     73   !! $Id$  
    7474   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7575   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    2323   !!--------------------------------------------------------------------------------- 
    2424   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    25    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $  
     25   !! $Id$  
    2626   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!--------------------------------------------------------------------------------- 
    … …  
    3939      ! 
    4040      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    41       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     41      CHARACTER(LEN=50)   ::   clname   ! output restart file name 
     42      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    4243      CHARACTER (len=35) :: charout 
    4344      INTEGER :: jl,  jk, jn               ! loop indice 
    … …  
    5152         ENDIF 
    5253         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out) 
    53          IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  '//clname 
    54          CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 
     54         clpath = TRIM(cn_trcrst_outdir) 
     55         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     56         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname) 
     57         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 
    5558      ENDIF 
    5659 
    … …  
    133136      INTEGER ::  jlibalt = jprstlib 
    134137      LOGICAL ::  llok 
     138      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    135139      !!----------------------------------------------------------------------------- 
    136140       
    … …  
    141145      ENDIF 
    142146       
     147      clpath = TRIM(cn_trcrst_indir) 
     148      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     149 
    143150      IF ( jprstlib == jprstdimg ) THEN 
    144151        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    145152        ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90 
    146         INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
     153        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
    147154        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    148155      ENDIF 
    149156 
    150       CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt )  
     157      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt )  
    151158       
    152159      IF( ln_trdmxl_trc_instant ) THEN  

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    35    !! $Header:  $  
     35   !! $Id$  
    3636   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    • Property svn:keywords set to Id
    r4990 r5350  
    118118   !!---------------------------------------------------------------------- 
    119119   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    120    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $  
     120   !! $Id$  
    121121   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    122122   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r4990 r5350  
    5454   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
    5555   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     56   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory 
    5657   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
     58   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
    5759   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
    5860   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
    … …  
    172174   !!---------------------------------------------------------------------- 
    173175   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
    174    !! $Id$  
     176   !! $Id$ 
    175177   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    176178   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    • Property svn:keywords set to Id
    r4624 r5350  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    46    !! $Id: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $  
     46   !! $Id$  
    4747   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r4990 r5350  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     41   !! $Id$ 
    4242   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    … …  
    175175      !!--------------------------------------------------------------------- 
    176176      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    177         &                  cn_trcrst_in, cn_trcrst_out 
     177        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
     178 
    178179 
    179180      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    … …  
    339340   !!---------------------------------------------------------------------- 
    340341   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    341    !! $Id$  
     342   !! $Id$ 
    342343   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    343344   !!====================================================================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r4990 r5350  
    5151      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5252      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name 
     53      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file 
    5354      !!---------------------------------------------------------------------- 
    5455      ! 
    … …  
    5657         IF( kt == nittrc000 ) THEN 
    5758            lrst_trc = .FALSE. 
    58             nitrst = nitend 
    59          ENDIF 
    60  
    61          IF( MOD( kt - 1, nstock ) == 0 ) THEN 
     59            IF( ln_rst_list ) THEN 
     60               nrst_lst = 1 
     61               nitrst = nstocklist( nrst_lst ) 
     62            ELSE 
     63               nitrst = nitend 
     64            ENDIF 
     65         ENDIF 
     66 
     67         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
    6268            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    6369            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    … …  
    7985         IF(lwp) WRITE(numout,*) 
    8086         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out) 
    81          IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname 
    82          CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 
     87         clpath = TRIM(cn_trcrst_outdir) 
     88         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     89         IF(lwp) WRITE(numout,*) & 
     90             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname 
     91         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 
    8392         lrst_trc = .TRUE. 
    8493      ENDIF 
    … …  
    140149          lrst_trc = .FALSE. 
    141150#endif 
     151          IF( lk_offline .AND. ln_rst_list ) THEN 
     152             nrst_lst = nrst_lst + 1 
     153             nitrst = nstocklist( nrst_lst ) 
     154          ENDIF 
    142155      ENDIF 
    143156      ! 
    … …  
    190203           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    191204           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    192            INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
     205           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    193206           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    194207         ENDIF 
    195208 
    196          CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     209         CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 
    197210 
    198211         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
    … …  
    306319   !!---------------------------------------------------------------------- 
    307320   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    308    !! $Id$  
     321   !! $Id$ 
    309322   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    310323   !!====================================================================== 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    • Property svn:keywords set to Id
    r4611 r5350  
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    50    !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $  
     50   !! $Id$  
    5151   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5252   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV

    r4277 r5350  
    22#! 
    33#BSUB -q long 
    4 #BSUB -n NPROCS 
     4#BSUB -n TOTAL_NPROCS 
    55#BSUB -J MPI_config 
    66#BSUB -o stdout.%J 
    … …  
    1414# 
    1515  OCEANCORES=NPROCS 
     16  XIOS_NUMPROCS=NXIOPROCS 
    1617  export SETTE_DIR=DEF_SETTE_DIR 
    1718 
    … …  
    2324# 
    2425 
     26 MPIPROGINF=detail 
     27 export MPIPROGINF 
     28 export LSF_PJL_TYPE="intelmpi" 
     29 export MP_PGMMODEL=mpmd 
     30 export MP_SHARED_MEMORY=yes 
    2531 export MPIRUN="mpirun -n $OCEANCORES" 
    26  
    27 #export MPIRUN="mpirun -np" 
     32 export MPIRUN_MPMD="mpirun -np $OCEANCORES ./opa : -np $XIOS_NUMPROCS /home/delrosso/XIOS_1.0/xios-1.0/bin/xios_server.exe" 
    2833 
    2934# 
    … …  
    6772 
    6873  if [ MPI_FLAG == "yes" ]; then 
    69      time ${MPIRUN} ./opa 
     74     if [ $XIOS_NUMPROCS -eq 0 ]; then 
     75       time ${MPIRUN} ./opa 
     76     else 
     77       time ${MPIRUN_MPMD} 
     78     fi 
    7079  else 
    71      time ./opa 
     80       time ./opa 
    7281  fi 
    7382# 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/SETTE/sette.sh

    r4990 r5350  
    10001000    export TEST_NAME="LONG" 
    10011001    cd ${CONFIG_DIR} 
    1002     . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -r ISOMIP -j 8 del_key ${DEL_KEYS} 
     1002    . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -u ISOMIP -j 8 del_key ${DEL_KEYS} 
    10031003    cd ${SETTE_DIR} 
    10041004    . ./param.cfg 
    … …  
    10681068    export TEST_NAME="REPRO_1_4" 
    10691069    cd ${CONFIG_DIR} 
    1070     . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -r ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
     1070    . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -u ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
    10711071    cd ${SETTE_DIR} 
    10721072    . ./param.cfg 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh

    r3294 r5350  
    1212#   ../TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh 
    1313# 
    14 set -ue 
     14set -u 
    1515# 
    1616echo "check for all *90 files contained in "$( pwd )" and its subdirectories" 
    1717# 
    18 for ff in $( grep -il wrk_nemo_2 $( find . -name "*90" ) ) 
     18for ff in $( grep -il "^ *use  *wrk_nemo" $( find . -name "*90" )  $( find . -name "*h90" ) ) 
    1919do 
    20  
    2120    # number of lines with wrk_alloc 
    22     n1=$( grep -ic "call *wrk_alloc *(" $ff )   
    23     # replace wrk_alloc with wrk_dealloc and count the lines 
    24     n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" ) 
    25     # we should get n2 = 2 * n1... 
    26     [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff"  
    27     
    28     # same story but for wrk_dealloc 
    29     n1=$( grep -ic "call *wrk_dealloc *(" $ff )   
    30     n2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 
    31     [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_dealloc in $ff"  
    32     
     21    n1=$( grep -ic "call *wrk_alloc *(" $ff ) 
     22    # number of lines with wrk_dealloc 
     23    nn1=$( grep -ic "call *wrk_dealloc *(" $ff )   
     24     
     25    if [ $(( $n1 + $nn1 )) -ne 0 ] 
     26    then 
     27   # replace wrk_alloc with wrk_dealloc and count the lines 
     28   n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" ) 
     29   # we should get n2 = 2 * n1... 
     30   [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff"  
     31    
     32   # same story but for wrk_dealloc 
     33   nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 
     34   [ $(( 2 * $nn1 )) -ne $nn2 ] && echo "problem with wrk_dealloc in $ff"  
     35    fi 
     36     
    3337done 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-amm12.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_bdy key_tide key_vectopt_loop key_amm_12km key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput 
     2  key_bdy key_tide key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-gyre.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 
     2  key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_gyre key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi 
     2  key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     2  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi 
     2  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi 
     2  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi 

  • branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg

    r4204 r5350  
    11preprocess.prop{fpp.defs} = \ 
    2   key_trabbl key_orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi 
     2  key_trabbl key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi 
Note: See TracChangeset for help on using the changeset viewer.