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

Changeset 5535


Ignore:
Timestamp:
2015-07-02T16:00:36+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO/dev_r5107_eorca025_closea branch to rev 5518 of trunk
(= branching point of NEMO 3.6_stable).

Location:
branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM
Files:
4 deleted
45 edited
2 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r5449 r5535  
    9999   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    100100   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
     101   ln_apr_dyn  = .false.    !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
     102 
    101103/ 
    102104!----------------------------------------------------------------------- 
    … …  
    158160!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    159161!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    160    sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   '' , '' 
     162   sn_apr     = 'amm12_mslp'     ,          1        ,  'p_msl'      , .false.      , .false. , 'daily'   ,  ''      ,  '' , '' 
    161163 
    162    cn_dir      = './'      !  root directory for the location of the bulk files 
    163    rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/ 
     164   cn_dir      = './fluxes/' !  root directory for the location of the bulk files 
     165   rn_pref     = 101000.    !  reference atmospheric pressure   [N/m2]/ 
    164166   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F) 
    165    ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data 
     167   ln_apr_obc  = .true.    !  inverse barometer added to OBC ssh data 
    166168/ 
    167169!----------------------------------------------------------------------- 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg

    r4990 r5535  
    9494   sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
    9595   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
     96 
    9697   cn_dir      = './'      !  root directory for the location of the bulk files 
    97    ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    9898   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    99    ln_bulk2z   = .false.   !  Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu 
    100    rn_zqt      = 3.        !  Air temperature and humidity reference height (m) (ln_bulk2z) 
    101    rn_zu       = 4.        !  Wind vector reference height (m)                  (ln_bulk2z) 
     99   rn_zqt      = 10.        !  Air temperature and humidity reference height (m) 
     100   rn_zu       = 10.        !  Wind vector reference height (m) 
    102101   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    103102   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    104    rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity  
     103   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
    105104                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
    106105/ 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml

    r5449 r5535  
    6464     <field field_ref="sst"    name="sst_1d_inst" operation="instant" />     <!-- instant value --> 
    6565     <field field_ref="sst"    name="sst_1d_max"  operation="maximum" />     <!-- max --> 
    66      <field field_ref="suoce"  />   <!-- include a U-grid variable in the list --> 
     66     <field field_ref="ssu"  />   <!-- include a U-grid variable in the list --> 
    6767   </file> 
    6868    
    … …  
    7878     
    7979   <axis_definition>   
    80       <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" /> 
    81       <axis id="deptht_myzoom" zoom_begin="1" zoom_end="10   " axis_ref="deptht" /> 
     80      <axis_group id="deptht" long_name="Vertical T levels" unit="m" positive="down" >  
     81         <axis id="deptht" />  
     82         <axis id="deptht_myzoom" zoom_begin="1" zoom_end="10" />  
     83      </axis_group> 
    8284      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" /> 
    8385      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" /> 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg

    r4990 r5535  
    9494   sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
    9595   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
     96 
    9697   cn_dir      = './'      !  root directory for the location of the bulk files 
    97    ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    9898   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    99    ln_bulk2z   = .false.   !  Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu 
    100    rn_zqt      = 3.        !  Air temperature and humidity reference height (m) (ln_bulk2z) 
    101    rn_zu       = 4.        !  Wind vector reference height (m)                  (ln_bulk2z) 
     99   rn_zqt      = 10.        !  Air temperature and humidity reference height (m) 
     100   rn_zu       = 10.        !  Wind vector reference height (m) 
    102101   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    103102   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    104    rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity  
     103   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
    105104                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
    106105/ 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r5449 r5535  
    190190          <field field_ref="salinity_cat"    name="salincat" /> 
    191191          <field field_ref="brinevol_cat"    name="sibricat" /> 
     192     <field field_ref="icetemp_cat"     name="sitemcat" /> 
     193     <field field_ref="snwtemp_cat"     name="sntemcat" /> 
    192194 
    193195   </file> 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5449 r5535  
    4242         <field id="sssmin"       long_name="min of sea surface salinity"   field_ref="sss"   operation="minimum"                 /> 
    4343         <field id="sbs"          long_name="sea bottom salinity"                                                     unit="1e-3" /> 
     44 
     45         <field id="taubot"       long_name="bottom stress module"                                                    unit="N/m2" />  
    4446 
    4547         <field id="ssh"          long_name="sea surface height"             standard_name="sea_surface_height_above_geoid"             unit="m" /> 
    … …  
    279281         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="g/kg"   axis_ref="ncatice" /> 
    280282         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      axis_ref="ncatice" /> 
     283         <field id="icetemp_cat"  long_name="Ice temperature for categories"                               unit="degC"   axis_ref="ncatice" /> 
     284         <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degC"   axis_ref="ncatice" /> 
    281285 
    282286         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     /> 
    … …  
    366370         <field id="ssu"          long_name="ocean surface current along i-axis"                                                                 unit="m/s"                             /> 
    367371         <field id="sbu"          long_name="ocean bottom current along i-axis"                                                                  unit="m/s"                             /> 
     372         <field id="ubar"         long_name="ocean barotropic current along i-axis"                                                              unit="m/s"                             /> 
    368373         <field id="uocetr_eff"   long_name="Effective ocean transport along i-axis"                 standard_name="ocean_volume_x_transport"    unit="m3/s"       grid_ref="grid_U_3D" /> 
    369374         <field id="uocet"        long_name="ocean transport along i-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_U_3D" /> 
    … …  
    400405         <field id="ssv"          long_name="ocean surface current along j-axis"                                                                 unit="m/s"                             /> 
    401406         <field id="sbv"          long_name="ocean bottom current along j-axis"                                                                  unit="m/s"                             /> 
     407         <field id="vbar"         long_name="ocean barotropic current along j-axis"                                                              unit="m/s"                             /> 
    402408         <field id="vocetr_eff"   long_name="Effective ocean transport along j-axis"                 standard_name="ocean_volume_y_transport"    unit="m3/s"       grid_ref="grid_V_3D" /> 
    403409         <field id="vocet"        long_name="ocean transport along j-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_V_3D" /> 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5449 r5535  
    476476 
    477477   cn_dir      = './'       !  root directory for the location of the bulk files 
    478    rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/ 
     478   rn_pref     = 101000.    !  reference atmospheric pressure   [N/m2]/ 
    479479   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F) 
    480480   ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r5449 r5535  
    3030 
    3131   PUBLIC   lim_thd_dh      ! called by lim_thd 
    32    PUBLIC   lim_thd_snwblow ! called in sbcblk/sbccpl and here 
     32   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here 
    3333 
    3434   INTERFACE lim_thd_snwblow 
    … …  
    122122      END SELECT 
    123123 
    124       CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
    125       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s, zsnw ) 
     124      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
     125      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
    126126      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 
    127127      CALL wrk_alloc( jpij, nlay_i, icount ) 
    128        
     128        
    129129      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
    130130      dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
    131   
    132       zqprec (:) = 0._wp ; zq_su  (:) = 0._wp ; zq_bo  (:) = 0._wp ; zf_tt  (:) = 0._wp 
    133       zq_rema(:) = 0._wp 
    134  
    135       zdh_s_pre(:) = 0._wp 
    136       zdh_s_mel(:) = 0._wp 
    137       zdh_s_sub(:) = 0._wp 
    138       zqh_s    (:) = 0._wp       
    139       zqh_i    (:) = 0._wp    
    140  
    141       zh_i      (:,:) = 0._wp        
    142       zdeltah   (:,:) = 0._wp        
    143       icount    (:,:) = 0 
     131 
     132      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp 
     133      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp 
     134      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp 
     135      zqh_s    (:) = 0._wp ; zq_s     (:) = 0._wp      
     136 
     137      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp        
     138      icount (:,:) = 0 
     139 
    144140 
    145141      ! Initialize enthalpy at nlay_i+1 
    … …  
    223219      ! Martin Vancoppenolle, December 2006 
    224220 
     221      CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing 
     222 
    225223      zdeltah(:,:) = 0._wp 
    226       CALL lim_thd_snwblow( 1. - at_i_1d, zsnw ) ! snow distribution over ice after wind blowing 
    227224      DO ji = kideb, kiut 
    228225         !----------- 
    … …  
    689686      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 
    690687       
    691       CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 
    692       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s, zsnw ) 
     688      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
     689      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
    693690      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 
    694691      CALL wrk_dealloc( jpij, nlay_i, icount ) 
    … …  
    703700   !!-------------------------------------------------------------------------- 
    704701   SUBROUTINE lim_thd_snwblow_2d( pin, pout ) 
    705       REAL(wp), DIMENSION(:,:), INTENT(in) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) ) 
    706       REAL(wp), DIMENSION(:,:), INTENT(out) :: pout 
     702      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) ) 
     703      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 
    707704      pout = ( 1._wp - ( pin )**rn_betas ) 
    708705   END SUBROUTINE lim_thd_snwblow_2d 
    709706 
    710707   SUBROUTINE lim_thd_snwblow_1d( pin, pout ) 
    711       REAL(wp), DIMENSION(:), INTENT(in) :: pin 
    712       REAL(wp), DIMENSION(:), INTENT(out) :: pout 
     708      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin 
     709      REAL(wp), DIMENSION(:), INTENT(inout) :: pout 
    713710      pout = ( 1._wp - ( pin )**rn_betas ) 
    714711   END SUBROUTINE lim_thd_snwblow_1d 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r5449 r5535  
    756756 
    757757      ! --- diagnose the change in non-solar flux due to surface temperature change --- ! 
    758       IF ( ln_it_qnsice ) hfx_err_dif_1d(:) = hfx_err_dif_1d(:) - ( qns_ice_1d(:)  - zqns_ice_b(:) ) * a_i_1d(:)  
     758      IF ( ln_it_qnsice ) THEN 
     759         DO ji = kideb, kiut 
     760            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji)  
     761         END DO 
     762      END IF 
    759763 
    760764      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    … …  
    790794      CALL wrk_dealloc( jpij, numeqmin, numeqmax ) 
    791795      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
    792       CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zghe ) 
     796      CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 
    793797      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 ) 
    794798      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r5449 r5535  
    6060      REAL(wp) ::  z1_365 
    6161      REAL(wp) ::  ztmp 
    62       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s 
    6363      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace 
    6464      !!------------------------------------------------------------------- 
    … …  
    6666      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    6767 
    68       CALL wrk_alloc( jpi, jpj, jpl, zoi, zei ) 
     68      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
    6969      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi ) 
    7070 
    … …  
    243243      CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories 
    244244      CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
     245 
     246      ! ice temperature 
     247      IF ( iom_use( "icetemp_cat" ) ) THEN  
     248         zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 
     249         CALL iom_put( "icetemp_cat"   , zt_i - rt0  ) 
     250      ENDIF 
     251       
     252      ! snow temperature 
     253      IF ( iom_use( "snwtemp_cat" ) ) THEN  
     254         zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 
     255         CALL iom_put( "snwtemp_cat"   , zt_s - rt0  ) 
     256      ENDIF 
    245257 
    246258      ! Compute ice age 
    … …  
    280292      !     not yet implemented 
    281293       
    282       CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei ) 
     294      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
    283295      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db ) 
    284296 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r5307 r5535  
    11MODULE domrea 
    2    !!====================================================================== 
    3    !!                       ***  MODULE domrea  *** 
    4    !! Ocean initialization : read the ocean domain meshmask file(s) 
    5    !!====================================================================== 
    6    !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line 
     2   !!============================================================================== 
     3   !!                       ***  MODULE domrea   *** 
     4   !! Ocean initialization : domain initialization 
     5   !!============================================================================== 
     6 
    77   !!---------------------------------------------------------------------- 
    8  
     8   !!   dom_init       : initialize the space and time domain 
     9   !!   dom_nam        : read and contral domain namelists 
     10   !!   dom_ctl        : control print for the ocean domain 
    911   !!---------------------------------------------------------------------- 
    10    !!   dom_rea        : read mesh and mask file(s) 
    11    !!                    nmsh = 1  :   mesh_mask file 
    12    !!                         = 2  :   mesh and mask file 
    13    !!                         = 3  :   mesh_hgr, mesh_zgr and mask 
    14    !!---------------------------------------------------------------------- 
     12   !! * Modules used 
     13   USE oce             !  
    1514   USE dom_oce         ! ocean space and time domain 
    16    USE dommsk          ! domain: masks 
     15   USE phycst          ! physical constants 
     16   USE in_out_manager  ! I/O manager 
     17   USE lib_mpp         ! distributed memory computing library 
     18 
     19   USE domstp          ! domain: set the time-step 
     20 
    1721   USE lbclnk          ! lateral boundary condition - MPP exchanges 
    1822   USE trc_oce         ! shared ocean/biogeochemical variables 
    19    USE lib_mpp  
    20    USE in_out_manager 
    2123   USE wrk_nemo   
    22  
     24    
    2325   IMPLICIT NONE 
    2426   PRIVATE 
    2527 
    26    PUBLIC   dom_rea    ! routine called by inidom.F90 
    27   !! * Substitutions 
     28   !! * Routine accessibility 
     29   PUBLIC dom_rea       ! called by opa.F90 
     30 
     31   !! * Substitutions 
    2832#  include "domzgr_substitute.h90" 
     33#  include "vectopt_loop_substitute.h90" 
    2934   !!---------------------------------------------------------------------- 
    3035   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    3136   !! $Id$ 
    32    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3338   !!---------------------------------------------------------------------- 
     39 
    3440CONTAINS 
    3541 
    … …  
    3743      !!---------------------------------------------------------------------- 
    3844      !!                  ***  ROUTINE dom_rea  *** 
     45      !!                     
     46      !! ** Purpose :   Domain initialization. Call the routines that are  
     47      !!      required to create the arrays which define the space and time 
     48      !!      domain of the ocean model. 
     49      !! 
     50      !! ** Method  : 
     51      !!      - dom_stp: defined the model time step 
     52      !!      - dom_rea: read the meshmask file if nmsh=1 
     53      !! 
     54      !! History : 
     55      !!        !  90-10  (C. Levy - G. Madec)  Original code 
     56      !!        !  91-11  (G. Madec) 
     57      !!        !  92-01  (M. Imbard) insert time step initialization 
     58      !!        !  96-06  (G. Madec) generalized vertical coordinate  
     59      !!        !  97-02  (G. Madec) creation of domwri.F 
     60      !!        !  01-05  (E.Durand - G. Madec) insert closed sea 
     61      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
     62      !!---------------------------------------------------------------------- 
     63      !! * Local declarations 
     64      INTEGER ::   jk                ! dummy loop argument 
     65      INTEGER ::   iconf = 0         ! temporary integers 
     66      !!---------------------------------------------------------------------- 
     67 
     68      IF(lwp) THEN 
     69         WRITE(numout,*) 
     70         WRITE(numout,*) 'dom_init : domain initialization' 
     71         WRITE(numout,*) '~~~~~~~~' 
     72      ENDIF 
     73 
     74      CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     75      CALL dom_zgr      ! Vertical mesh and bathymetry option 
     76      CALL dom_grd      ! Create a domain file 
     77 
     78     ! 
     79      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 
     80      !        but could be usefull in many other routines 
     81      e12t    (:,:) = e1t(:,:) * e2t(:,:) 
     82      e1e2t   (:,:) = e1t(:,:) * e2t(:,:) 
     83      e12u    (:,:) = e1u(:,:) * e2u(:,:) 
     84      e12v    (:,:) = e1v(:,:) * e2v(:,:) 
     85      e12f    (:,:) = e1f(:,:) * e2f(:,:) 
     86      r1_e12t (:,:) = 1._wp    / e12t(:,:) 
     87      r1_e12u (:,:) = 1._wp    / e12u(:,:) 
     88      r1_e12v (:,:) = 1._wp    / e12v(:,:) 
     89      r1_e12f (:,:) = 1._wp    / e12f(:,:) 
     90      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     91      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     92      ! 
     93      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points 
     94      hv(:,:) = 0._wp 
     95      DO jk = 1, jpk 
     96         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
     97         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
     98      END DO 
     99      !                                        ! Inverse of the local depth 
     100      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
     101      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
     102 
     103      CALL dom_stp      ! Time step 
     104      CALL dom_msk      ! Masks 
     105      CALL dom_ctl      ! Domain control 
     106 
     107   END SUBROUTINE dom_rea 
     108 
     109   SUBROUTINE dom_nam 
     110      !!---------------------------------------------------------------------- 
     111      !!                     ***  ROUTINE dom_nam  *** 
     112      !!                     
     113      !! ** Purpose :   read domaine namelists and print the variables. 
     114      !! 
     115      !! ** input   : - namrun namelist 
     116      !!              - namdom namelist 
     117      !!              - namcla namelist 
     118      !!---------------------------------------------------------------------- 
     119      USE ioipsl 
     120      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     121      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     122         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     123         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
     124         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
     125      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   & 
     126         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            & 
     127         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, & 
     128         &             jphgr_msh, & 
     129         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
     130         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
     131         &             ppa2, ppkth2, ppacr2 
     132      NAMELIST/namcla/ nn_cla 
     133#if defined key_netcdf4 
     134      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
     135#endif 
     136      !!---------------------------------------------------------------------- 
     137 
     138      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
     139      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
     140901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
     141 
     142      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
     143      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
     144902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
     145      IF(lwm) WRITE ( numond, namrun ) 
     146      ! 
     147      IF(lwp) THEN                  ! control print 
     148         WRITE(numout,*) 
     149         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read' 
     150         WRITE(numout,*) '~~~~~~~ ' 
     151         WRITE(numout,*) '   Namelist namrun'   
     152         WRITE(numout,*) '      job number                      nn_no      = ', nn_no 
     153         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp 
     154         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
     155         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl 
     156         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000 
     157         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend 
     158         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0 
     159         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
     160         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
     161         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     162         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
     163         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
     164         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
     165         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta 
     166         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
     167         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
     168      ENDIF 
     169      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon) 
     170      cexper = cn_exp 
     171      nrstdt = nn_rstctl 
     172      nit000 = nn_it000 
     173      nitend = nn_itend 
     174      ndate0 = nn_date0 
     175      nleapy = nn_leapy 
     176      ninist = nn_istate 
     177      nstock = nn_stock 
     178      nstocklist = nn_stocklist 
     179      nwrite = nn_write 
     180 
     181 
     182      !                             ! control of output frequency 
     183      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
     184         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 
     185         CALL ctl_warn( ctmp1 ) 
     186         nstock = nitend 
     187      ENDIF 
     188      IF ( nwrite == 0 ) THEN 
     189         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 
     190         CALL ctl_warn( ctmp1 ) 
     191         nwrite = nitend 
     192      ENDIF 
     193 
     194      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
     195      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     196      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     197 
     198#if defined key_agrif 
     199      IF( Agrif_Root() ) THEN 
     200#endif 
     201      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     202      CASE (  1 )  
     203         CALL ioconf_calendar('gregorian') 
     204         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
     205      CASE (  0 ) 
     206         CALL ioconf_calendar('noleap') 
     207         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
     208      CASE ( 30 ) 
     209         CALL ioconf_calendar('360d') 
     210         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     211      END SELECT 
     212#if defined key_agrif 
     213      ENDIF 
     214#endif 
     215 
     216      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
     217      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
     218903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
     219 
     220      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
     221      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
     222904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     223      IF(lwm) WRITE ( numond, namdom ) 
     224 
     225      IF(lwp) THEN 
     226         WRITE(numout,*)  
     227         WRITE(numout,*) '   Namelist namdom : space & time domain' 
     228         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy 
     229         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy 
     230         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin 
     231         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)' 
     232         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat 
     233         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh 
     234         WRITE(numout,*) '           = 0   no file created                 ' 
     235         WRITE(numout,*) '           = 1   mesh_mask                       ' 
     236         WRITE(numout,*) '           = 2   mesh and mask                   ' 
     237         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      ' 
     238         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt 
     239         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp 
     240         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro 
     241         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc 
     242         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin 
     243         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax 
     244         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth 
     245         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea 
     246         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh 
     247         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0 
     248         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0 
     249         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg 
     250         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg 
     251         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m 
     252         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m 
     253         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur 
     254         WRITE(numout,*) '                                        ppa0            = ', ppa0 
     255         WRITE(numout,*) '                                        ppa1            = ', ppa1 
     256         WRITE(numout,*) '                                        ppkth           = ', ppkth 
     257         WRITE(numout,*) '                                        ppacr           = ', ppacr 
     258         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin 
     259         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax 
     260         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh 
     261         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2 
     262         WRITE(numout,*) '                                      ppkth2            = ', ppkth2 
     263         WRITE(numout,*) '                                      ppacr2            = ', ppacr2 
     264      ENDIF 
     265 
     266      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon) 
     267      e3zps_min = rn_e3zps_min 
     268      e3zps_rat = rn_e3zps_rat 
     269      nmsh      = nn_msh 
     270      nacc      = nn_acc 
     271      atfp      = rn_atfp 
     272      rdt       = rn_rdt 
     273      rdtmin    = rn_rdtmin 
     274      rdtmax    = rn_rdtmin 
     275      rdth      = rn_rdth 
     276 
     277      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection 
     278      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905) 
     279905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp ) 
     280 
     281      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection 
     282      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 
     283906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 
     284      IF(lwm) WRITE( numond, namcla ) 
     285 
     286      IF(lwp) THEN 
     287         WRITE(numout,*) 
     288         WRITE(numout,*) '   Namelist namcla' 
     289         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
     290      ENDIF 
     291 
     292#if defined key_netcdf4 
     293      !                             ! NetCDF 4 case   ("key_netcdf4" defined) 
     294      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF 
     295      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
     296907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
     297 
     298      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF 
     299      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
     300908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
     301      IF(lwm) WRITE( numond, namnc4 ) 
     302      IF(lwp) THEN                        ! control print 
     303         WRITE(numout,*) 
     304         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters' 
     305         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i 
     306         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j 
     307         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k 
     308         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 
     309      ENDIF 
     310 
     311      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module) 
     312      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1 
     313      snc4set%ni   = nn_nchunks_i 
     314      snc4set%nj   = nn_nchunks_j 
     315      snc4set%nk   = nn_nchunks_k 
     316      snc4set%luse = ln_nc4zip 
     317#else 
     318      snc4set%luse = .FALSE.        ! No NetCDF 4 case 
     319#endif 
     320      ! 
     321   END SUBROUTINE dom_nam 
     322 
     323   SUBROUTINE dom_zgr 
     324      !!---------------------------------------------------------------------- 
     325      !!                ***  ROUTINE dom_zgr  *** 
     326      !!                    
     327      !! ** Purpose :  set the depth of model levels and the resulting  
     328      !!      vertical scale factors. 
     329      !! 
     330      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d) 
     331      !!              - read/set ocean depth and ocean levels (bathy, mbathy) 
     332      !!              - vertical coordinate (gdep., e3.) depending on the  
     333      !!                coordinate chosen : 
     334      !!                   ln_zco=T   z-coordinate   
     335      !!                   ln_zps=T   z-coordinate with partial steps 
     336      !!                   ln_zco=T   s-coordinate  
     337      !! 
     338      !! ** Action  :   define gdep., e3., mbathy and bathy 
     339      !!---------------------------------------------------------------------- 
     340      INTEGER ::   ioptio = 0   ! temporary integer 
     341      INTEGER ::   ios 
     342      !! 
     343      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
     344      !!---------------------------------------------------------------------- 
     345 
     346      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate 
     347      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 ) 
     348901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 
     349 
     350      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate 
     351      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
     352902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
     353      IF(lwm) WRITE ( numond, namzgr ) 
     354 
     355      IF(lwp) THEN                     ! Control print 
     356         WRITE(numout,*) 
     357         WRITE(numout,*) 'dom_zgr : vertical coordinate' 
     358         WRITE(numout,*) '~~~~~~~' 
     359         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate' 
     360         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco 
     361         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps 
     362         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco 
     363         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav 
     364      ENDIF 
     365 
     366      ioptio = 0                       ! Check Vertical coordinate options 
     367      IF( ln_zco ) ioptio = ioptio + 1 
     368      IF( ln_zps ) ioptio = ioptio + 1 
     369      IF( ln_sco ) ioptio = ioptio + 1 
     370      IF( ln_isfcav ) ioptio = 33 
     371      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' ) 
     372      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' ) 
     373 
     374   END SUBROUTINE dom_zgr 
     375 
     376   SUBROUTINE dom_ctl 
     377      !!---------------------------------------------------------------------- 
     378      !!                     ***  ROUTINE dom_ctl  *** 
     379      !! 
     380      !! ** Purpose :   Domain control. 
     381      !! 
     382      !! ** Method  :   compute and print extrema of masked scale factors 
     383      !! 
     384      !! History : 
     385      !!   8.5  !  02-08  (G. Madec)    Original code 
     386      !!---------------------------------------------------------------------- 
     387      !! * Local declarations 
     388      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
     389      INTEGER, DIMENSION(2) ::   iloc      !  
     390      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
     391      !!---------------------------------------------------------------------- 
     392 
     393      ! Extrema of the scale factors 
     394 
     395      IF(lwp)WRITE(numout,*) 
     396      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
     397      IF(lwp)WRITE(numout,*) '~~~~~~~' 
     398 
     399      IF (lk_mpp) THEN 
     400         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 
     401         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 
     402         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 ) 
     403         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 
     404      ELSE 
     405         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     406         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     407         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     408         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     409 
     410         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     411         iimi1 = iloc(1) + nimpp - 1 
     412         ijmi1 = iloc(2) + njmpp - 1 
     413         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     414         iimi2 = iloc(1) + nimpp - 1 
     415         ijmi2 = iloc(2) + njmpp - 1 
     416         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     417         iima1 = iloc(1) + nimpp - 1 
     418         ijma1 = iloc(2) + njmpp - 1 
     419         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     420         iima2 = iloc(1) + nimpp - 1 
     421         ijma2 = iloc(2) + njmpp - 1 
     422      ENDIF 
     423 
     424      IF(lwp) THEN 
     425         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
     426         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 
     427         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2 
     428         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
     429      ENDIF 
     430 
     431   END SUBROUTINE dom_ctl 
     432 
     433   SUBROUTINE dom_grd 
     434      !!---------------------------------------------------------------------- 
     435      !!                  ***  ROUTINE dom_grd  *** 
    39436      !!                    
    40437      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the 
    … …  
    344741      CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw ) 
    345742      ! 
    346    END SUBROUTINE dom_rea 
     743   END SUBROUTINE dom_grd 
    347744 
    348745 
    … …  
    388785   END SUBROUTINE zgr_bot_level 
    389786 
     787   SUBROUTINE dom_msk 
     788      !!--------------------------------------------------------------------- 
     789      !!                 ***  ROUTINE dom_msk  *** 
     790      !! 
     791      !! ** Purpose :   Off-line case: defines the interior domain T-mask. 
     792      !! 
     793      !! ** Method  :   The interior ocean/land mask is computed from tmask 
     794      !!              setting to zero the duplicated row and lines due to 
     795      !!              MPP exchange halos, est-west cyclic and north fold 
     796      !!              boundary conditions. 
     797      !! 
     798      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point 
     799      !!               tpol     : ??? 
     800      !!---------------------------------------------------------------------- 
     801      ! 
     802      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     803      INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     804      INTEGER, POINTER, DIMENSION(:,:) ::  imsk  
     805      ! 
     806      !!--------------------------------------------------------------------- 
     807       
     808      CALL wrk_alloc( jpi, jpj, imsk ) 
     809      ! 
     810      ! Interior domain mask (used for global sum) 
     811      ! -------------------- 
     812      ssmask(:,:)  = tmask(:,:,1) 
     813      tmask_i(:,:) = tmask(:,:,1) 
     814      iif = jpreci                        ! thickness of exchange halos in i-axis 
     815      iil = nlci - jpreci + 1 
     816      ijf = jprecj                        ! thickness of exchange halos in j-axis 
     817      ijl = nlcj - jprecj + 1 
     818      ! 
     819      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns 
     820      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns) 
     821      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows 
     822      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows) 
     823      ! 
     824      !                                   ! north fold mask 
     825      tpol(1:jpiglo) = 1._wp 
     826      !                                 
     827      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot 
     828      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot 
     829      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row 
     830         IF( mjg(ijl-1) == jpjglo-1 ) THEN 
     831            DO ji = iif+1, iil-1 
     832               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 
     833            END DO 
     834         ENDIF 
     835      ENDIF  
     836      ! 
     837      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at 
     838      ! least 1 wet u point 
     839      DO jj = 1, jpjm1 
     840         DO ji = 1, fs_jpim1   ! vector loop 
     841            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     842            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     843         END DO 
     844         DO ji = 1, jpim1      ! NO vector opt. 
     845            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     846               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
     847         END DO 
     848      END DO 
     849      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
     850      CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
     851      CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     852 
     853      ! 3. Ocean/land mask at wu-, wv- and w points  
     854      !---------------------------------------------- 
     855      wmask (:,:,1) = tmask(:,:,1) ! ???????? 
     856      wumask(:,:,1) = umask(:,:,1) ! ???????? 
     857      wvmask(:,:,1) = vmask(:,:,1) ! ???????? 
     858      DO jk=2,jpk 
     859         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 
     860         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)    
     861         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 
     862      END DO 
     863      ! 
     864      IF( nprint == 1 .AND. lwp ) THEN    ! Control print 
     865         imsk(:,:) = INT( tmask_i(:,:) ) 
     866         WRITE(numout,*) ' tmask_i : ' 
     867         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
     868         WRITE (numout,*) 
     869         WRITE (numout,*) ' dommsk: tmask for each level' 
     870         WRITE (numout,*) ' ----------------------------' 
     871         DO jk = 1, jpk 
     872            imsk(:,:) = INT( tmask(:,:,jk) ) 
     873            WRITE(numout,*) 
     874            WRITE(numout,*) ' level = ',jk 
     875            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
     876         END DO 
     877      ENDIF 
     878      ! 
     879      CALL wrk_dealloc( jpi, jpj, imsk ) 
     880      ! 
     881   END SUBROUTINE dom_msk 
     882 
    390883   !!====================================================================== 
    391884END MODULE domrea 
     885 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r5451 r5535  
    1818   USE c1d             ! 1D configuration 
    1919   USE domcfg          ! domain configuration               (dom_cfg routine) 
    20    USE domain          ! domain initialization             (dom_init routine) 
    21    USE istate          ! initial state setting          (istate_init routine) 
     20   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine) 
     21   USE domrea          ! domain initialization from mesh_mask            (dom_init routine) 
    2222   USE eosbn2          ! equation of state            (eos bn2 routine) 
    2323   !              ! ocean physics 
    … …  
    3434   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    3535   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
    36    USE stpctl          ! time stepping control            (stp_ctl routine) 
    3736   !              ! I/O & MPP 
    3837   USE iom             ! I/O library 
    … …  
    9594      istp = nit000 
    9695      !  
    97       CALL iom_init( "nemo" )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     96      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    9897      !  
    9998      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
    … …  
    108107      END DO 
    109108#if defined key_iomput 
    110       CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     109      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    111110#endif 
    112111 
    … …  
    143142      INTEGER ::   ilocal_comm   ! local integer 
    144143      INTEGER ::   ios 
     144      LOGICAL ::   llexist 
    145145      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    146146      !! 
    … …  
    182182      !                             !--------------------------------------------! 
    183183#if defined key_iomput 
    184       CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
     184      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 
    185185      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    186186#else 
    … …  
    269269      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    270270                            CALL     dom_cfg    ! Domain configuration 
    271                             CALL     dom_init   ! Domain 
     271      ! 
     272      INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist 
     273      ! 
     274      IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry 
     275      ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask 
     276      ENDIF 
    272277                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    273278 
    … …  
    276281      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    277282 
    278       !                                     ! Ocean physics 
    279283                            CALL     sbc_init   ! Forcings : surface module 
     284 
    280285#if ! defined key_degrad 
    281286                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
    … …  
    283288      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
    284289 
    285       !                                     ! Active tracers 
    286290                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    287291      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    288292 
    289                             CALL trc_nam_run  ! Needed to get restart parameters for passive tracers 
    290       IF( ln_rsttr ) THEN 
    291         neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    292         CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    293       ELSE 
    294         neuler = 0                  ! Set time-step indicator at nit000 (euler) 
    295         CALL day_init               ! set calendar 
    296       ENDIF 
    297       !                                     ! Dynamics 
     293                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
     294                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    298295                            CALL dta_dyn_init   ! Initialization for the dynamics 
    299296 
    300       !                                     ! Passive tracers 
    301297                            CALL     trc_init   ! Passive tracers initialization 
    302       ! 
    303       ! Initialise diaptr as some variables are used in if statements later (in 
    304       ! various advection and diffusion routines. 
    305                             CALL dia_ptr_init 
    306       ! 
    307       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     298                            CALL dia_ptr_init   ! Initialise diaptr as some variables are used  
     299      !                                         ! in various advection and diffusion routines 
     300      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
    308301      ! 
    309302      IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init') 
    … …  
    660653   END SUBROUTINE nemo_northcomms 
    661654#endif 
     655 
     656   SUBROUTINE istate_init 
     657      !!---------------------------------------------------------------------- 
     658      !!                   ***  ROUTINE istate_init  *** 
     659      !! 
     660      !! ** Purpose :   Initialization to zero of the dynamics and tracers. 
     661      !!---------------------------------------------------------------------- 
     662      ! 
     663      !     now fields         !     after fields      ! 
     664      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   ! 
     665      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   ! 
     666      wn   (:,:,:)   = 0._wp   !                       ! 
     667      hdivn(:,:,:)   = 0._wp   !                       ! 
     668      tsn  (:,:,:,:) = 0._wp   !                       ! 
     669      ! 
     670      rhd  (:,:,:) = 0.e0 
     671      rhop (:,:,:) = 0.e0 
     672      rn2  (:,:,:) = 0.e0 
     673      ! 
     674   END SUBROUTINE istate_init 
     675 
     676   SUBROUTINE stp_ctl( kt, kindic ) 
     677      !!---------------------------------------------------------------------- 
     678      !!                    ***  ROUTINE stp_ctl  *** 
     679      !! 
     680      !! ** Purpose :   Control the run 
     681      !! 
     682      !! ** Method  : - Save the time step in numstp 
     683      !! 
     684      !! ** Actions :   'time.step' file containing the last ocean time-step 
     685      !!---------------------------------------------------------------------- 
     686      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
     687      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
     688      !!---------------------------------------------------------------------- 
     689      ! 
     690      IF( kt == nit000 .AND. lwp ) THEN 
     691         WRITE(numout,*) 
     692         WRITE(numout,*) 'stp_ctl : time-stepping control' 
     693         WRITE(numout,*) '~~~~~~~' 
     694         ! open time.step file 
     695         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     696      ENDIF 
     697      ! 
     698      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
     699      IF(lwp) REWIND( numstp )                       ! -------------------------- 
     700      ! 
     701   END SUBROUTINE stp_ctl 
    662702   !!====================================================================== 
    663703END MODULE nemogcm 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r5451 r5535  
    176176 
    177177     !open output file 
    178      IF( lwp ) THEN 
     178     IF( lwm ) THEN 
    179179        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    180180        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    … …  
    283283           DO jsec=1,nb_sec 
    284284 
    285               IF( lwp )CALL dia_dct_wri(kt,jsec,secs(jsec)) 
     285              IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec)) 
    286286             
    287287              !nullify transports values after writing 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r5449 r5535  
    166166         CASE ( 1 )                                  !  ORCA_R1 configurations 
    167167            !                                        ! ======================= 
    168             ! This dirty section will be suppressed by simplification process: all this will come back in input files 
    169             ! Currently these hard-wired indices relate to the original (pre-v3.6) configuration  
    170             ! which had a grid-size of 362x292. 
    171             ! This grid has been extended southwards for use with the under ice-shelf options (isf) introduced in v3.6.  
    172             ! The original domain can still be used optionally if the isf code is not activated.  
    173             ! An adjustment (isrow) is made to the hard-wired indices if the extended domain (362x332) is being used. 
    174             !  
    175             IF    ( jpjglo == 292 ) THEN  ;  isrow = 0  ! Using pre-v3.6 files or adjusted start row from isf-extended grid 
    176             ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 40 ! Using full isf­extended domain.  
    177             ENDIF                                       ! Adjust j­indices to account for more southerly starting latitude 
     168            ! This dirty section will be suppressed by simplification process: 
     169            ! all this will come back in input files 
     170            ! Currently these hard-wired indices relate to configuration with 
     171            ! extend grid (jpjglo=332) 
     172            isrow = 332 - jpjglo 
     173            ! 
    178174            ii0 = 283           ;   ii1 = 283 
    179             ij0 = 201 + isrow   ;   ij1 = 201 + isrow 
     175            ij0 = 241 - isrow   ;   ij1 = 241 - isrow 
    180176            !                                        ! ======================= 
    181177         CASE DEFAULT                                !    ORCA R05 or R025 
    … …  
    223219         CASE ( 1 )                                  !  ORCA_R1 configurations 
    224220            !                                        ! ======================= 
    225             !  This dirty section will be suppressed by simplification process: 
    226             !  all this will come back in input files 
    227             IF    ( jpjglo == 292 ) THEN  ;  isrow = 0   
    228             ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 39 
    229             ENDIF                                       
     221            ! This dirty section will be suppressed by simplification process: 
     222            ! all this will come back in input files 
     223            ! Currently these hard-wired indices relate to configuration with 
     224            ! extend grid (jpjglo=332) 
     225            isrow = 332 - jpjglo 
    230226            ii0 = 282           ;   ii1 = 282 
    231             ij0 = 201 + isrow   ;   ij1 = 201 + isrow 
     227            ij0 = 240 - isrow   ;   ij1 = 240 - isrow 
    232228            !                                        ! ======================= 
    233229         CASE DEFAULT                                !    ORCA R05 or R025 
    … …  
    275271         CASE ( 1 )                                  !  ORCA_R1 configurations 
    276272            !                                        ! ======================= 
    277             !  This dirty section will be suppressed by simplification process: 
    278             !  all this will come back in input files 
    279             IF    ( jpjglo == 292 ) THEN  ;  isrow = 0   
    280             ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 39 
    281             ENDIF                                       
     273            ! This dirty section will be suppressed by simplification process: 
     274            ! all this will come back in input files 
     275            ! Currently these hard-wired indices relate to configuration with 
     276            ! extend grid (jpjglo=332) 
     277            isrow = 332 - jpjglo 
    282278            ii0 = 331           ;   ii1 = 331 
    283             ij0 = 176 + isrow   ;   ij1 = 176 + isrow 
     279            ij0 = 215 - isrow   ;   ij1 = 215 - isrow 
    284280            !                                        ! ======================= 
    285281         CASE DEFAULT                                !    ORCA R05 or R025 
    … …  
    327323         CASE ( 1 )                                  !  ORCA_R1 configurations 
    328324            !                                        ! ======================= 
    329             !  This dirty section will be suppressed by simplification process: 
    330             !  all this will come back in input files 
    331             IF    ( jpjglo == 292 ) THEN  ;  isrow = 0   
    332             ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 39 
    333             ENDIF                                       
     325            ! This dirty section will be suppressed by simplification process: 
     326            ! all this will come back in input files 
     327            ! Currently these hard-wired indices relate to configuration with 
     328            ! extend grid (jpjglo=332) 
     329            isrow = 332 - jpjglo 
    334330            ii0 = 297           ;   ii1 = 297 
    335             ij0 = 230 + isrow   ;   ij1 = 230 + isrow 
     331            ij0 = 269 - isrow   ;   ij1 = 269 - isrow 
    336332            !                                        ! ======================= 
    337333         CASE DEFAULT                                !    ORCA R05 or R025 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5449 r5535  
    4646   USE iom 
    4747   USE ioipsl 
     48   USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities      
     49 
    4850#if defined key_lim2 
    4951   USE limwri_2  
    … …  
    125127      !! 
    126128      INTEGER                      ::   ji, jj, jk              ! dummy loop indices 
     129      INTEGER                      ::   jkbot                   ! 
    127130      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    128131      !! 
    … …  
    148151         CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 
    149152      ENDIF 
     153 
     154      CALL iom_put( "ssh" , sshn )                 ! sea surface height 
     155      if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    150156       
    151157      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
    … …  
    154160         DO jj = 1, jpj 
    155161            DO ji = 1, jpi 
    156                z2d(ji,jj) = tsn(ji,jj,MAX(mbathy(ji,jj),1),jp_tem) 
     162               jkbot = mbkt(ji,jj) 
     163               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem) 
    157164            END DO 
    158165         END DO 
    … …  
    165172         DO jj = 1, jpj 
    166173            DO ji = 1, jpi 
    167                z2d(ji,jj) = tsn(ji,jj,MAX(mbathy(ji,jj),1),jp_sal) 
     174               jkbot = mbkt(ji,jj) 
     175               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal) 
    168176            END DO 
    169177         END DO 
    170178         CALL iom_put( "sbs", z2d )                ! bottom salinity 
     179      ENDIF 
     180 
     181      IF ( iom_use("taubot") ) THEN                ! bottom stress 
     182         z2d(:,:) = 0._wp 
     183         DO jj = 2, jpjm1 
     184            DO ji = fs_2, fs_jpim1   ! vector opt. 
     185               zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  & 
     186                      &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )       
     187               zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  & 
     188                      &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  )  
     189               z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)  
     190               ! 
     191            ENDDO 
     192         ENDDO 
     193         CALL lbc_lnk( z2d, 'T', 1. ) 
     194         CALL iom_put( "taubot", z2d )            
    171195      ENDIF 
    172196          
    … …  
    176200         DO jj = 1, jpj 
    177201            DO ji = 1, jpi 
    178                z2d(ji,jj) = un(ji,jj,MAX(mbathy(ji,jj),1)) 
     202               jkbot = mbku(ji,jj) 
     203               z2d(ji,jj) = un(ji,jj,jkbot) 
    179204            END DO 
    180205         END DO 
    181206         CALL iom_put( "sbu", z2d )                ! bottom i-current 
    182207      ENDIF 
     208#if defined key_dynspg_ts 
     209      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current 
     210#else 
     211      CALL iom_put(  "ubar", un_b(:,:)        )    ! barotropic i-current 
     212#endif 
    183213       
    184214      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current 
    … …  
    187217         DO jj = 1, jpj 
    188218            DO ji = 1, jpi 
    189                z2d(ji,jj) = vn(ji,jj,MAX(mbathy(ji,jj),1)) 
     219               jkbot = mbkv(ji,jj) 
     220               z2d(ji,jj) = vn(ji,jj,jkbot) 
    190221            END DO 
    191222         END DO 
    192223         CALL iom_put( "sbv", z2d )                ! bottom j-current 
     224      ENDIF 
     225#if defined key_dynspg_ts 
     226      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic j-current 
     227#else 
     228      CALL iom_put(  "vbar", vn_b(:,:)        )    ! barotropic j-current 
     229#endif 
     230 
     231      CALL iom_put( "woce", wn )                   ! vertical velocity 
     232      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
     233         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
     234         z2d(:,:) = rau0 * e12t(:,:) 
     235         DO jk = 1, jpk 
     236            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     237         END DO 
     238         CALL iom_put( "w_masstr" , z3d )   
     239         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    193240      ENDIF 
    194241 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r5451 r5535  
    7272      !!---------------------------------------------------------------------- 
    7373      INTEGER ::   jc            ! dummy loop indices 
     74      INTEGER :: isrow           ! local index 
    7475      !!---------------------------------------------------------------------- 
    7576       
    … …  
    9192         CASE ( 1 )                                  ! ORCA_R1 configuration 
    9293            !                                        ! ======================= 
     94            ! This dirty section will be suppressed by simplification process: 
     95            ! all this will come back in input files 
     96            ! Currently these hard-wired indices relate to configuration with 
     97            ! extend grid (jpjglo=332) 
     98            isrow = 332 - jpjglo 
     99            ! 
    93100            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea 
    94             ncsi1(1)   = 332  ; ncsj1(1)   = 203 
    95             ncsi2(1)   = 344  ; ncsj2(1)   = 235 
     101            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow 
     102            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow 
    96103            ncsir(1,1) = 1    ; ncsjr(1,1) = 1 
    97104            !                                         

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5449 r5535  
    162162            !                                             ! ===================== 
    163163            ! This dirty section will be suppressed by simplification process: all this will come back in input files 
    164             ! Currently these hard-wired indices relate to the original (pre-v3.6) configuration  
     164            ! Currently these hard-wired indices relate to configuration with 
     165            ! extend grid (jpjglo=332) 
    165166            ! which had a grid-size of 362x292. 
    166             ! This grid has been extended southwards for use with the under ice-shelf options (isf) introduced in v3.6.  
    167             ! The original domain can still be used optionally if the isf code is not activated.  
    168             ! An adjustment (isrow) is made to the hard-wired indices if the extended domain (362x332) is being used. 
    169167            !  
    170             IF    ( jpjglo == 292 ) THEN  ;  isrow = 0  ! Using pre-v3.6 files or adjusted start row from isf-extended grid 
    171             ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 40 ! Using full isf­extended domain.  
    172             ENDIF      
     168            isrow = 332 - jpjglo 
    173169            ! 
    174170            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km) 
    175             ij0 = 201 + isrow   ;   ij1 = 201 + isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
     171            ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
    176172            IF(lwp) WRITE(numout,*) 
    177173            IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km' 
    178174 
    179175            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km) 
    180             ij0 = 208 + isrow   ;   ij1 = 208 + isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
     176            ij0 = 208 + isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    181177            IF(lwp) WRITE(numout,*) 
    182178            IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km' 
    183179 
    184180            ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km) 
    185             ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3 
     181            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3 
    186182            IF(lwp) WRITE(numout,*) 
    187183            IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km' 
    188184 
    189185            ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 
    190             ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3 
     186            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3 
    191187            IF(lwp) WRITE(numout,*) 
    192188            IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km' 
    193189 
    194190            ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km) 
    195             ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3 
     191            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3 
    196192            IF(lwp) WRITE(numout,*) 
    197193            IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km' 
    198194 
    199195            ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km) 
    200             ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 
     196            ij0 = 124 + isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 
    201197            IF(lwp) WRITE(numout,*) 
    202198            IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km' 
    203199 
    204200            ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km) 
    205             ij0 = 141 + isrow   ;   ij1 = 142 + isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3 
     201            ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3 
    206202            IF(lwp) WRITE(numout,*) 
    207203            IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km' 
    208204 
    209205            ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km) 
    210             ij0 = 141 + isrow   ;   ij1 = 142 + isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3 
     206            ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3 
    211207            IF(lwp) WRITE(numout,*) 
    212208            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km' 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r5449 r5535  
    402402      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
    403403         !                                                 ! Increased lateral friction near of some straits 
    404          ! This dirty section will be suppressed by simplification process: all this will come back in input files 
    405          ! Currently these hard-wired indices relate to the original (pre-v3.6) configuration  
    406          ! which had a grid-size of 362x292. 
    407          ! This grid has been extended southwards for use with the under ice-shelf options (isf) introduced in v3.6.  
    408          ! The original domain can still be used optionally if the isf code is not activated.  
    409          ! An adjustment (isrow) is made to the hard-wired indices if the extended domain (362x332) is being used. 
    410          !  
    411          IF    ( jpjglo == 292 ) THEN  ;  isrow = 0  ! Using pre-v3.6 files or adjusted start row from isf-extended grid 
    412          ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 40 ! Using full isf­extended domain.  
    413          ENDIF      
    414  
     404         ! This dirty section will be suppressed by simplification process: 
     405         ! all this will come back in input files 
     406         ! Currently these hard-wired indices relate to configuration with 
     407         ! extend grid (jpjglo=332) 
     408         ! 
     409         isrow = 332 - jpjglo 
     410         ! 
    415411         IF(lwp) WRITE(numout,*) 
    416412         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
    417413         IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    418414         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait  
    419          ij0 = 201 + isrow   ;   ij1 = 201 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     415         ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    420416 
    421417         IF(lwp) WRITE(numout,*) '      Bhosporus ' 
    422418         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait  
    423          ij0 = 208 + isrow   ;   ij1 = 208 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     419         ij0 = 208 + isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    424420 
    425421         IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
    426422         ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)  
    427          ij0 = 149 + isrow   ;   ij1 = 150 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
     423         ij0 = 149 + isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    428424 
    429425         IF(lwp) WRITE(numout,*) '      Lombok ' 
    430426         ii0 =  44           ;   ii1 =  44        ! Lombok Strait  
    431          ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     427         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    432428 
    433429         IF(lwp) WRITE(numout,*) '      Ombai ' 
    434430         ii0 =  53           ;   ii1 =  53        ! Ombai Strait  
    435          ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     431         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    436432 
    437433         IF(lwp) WRITE(numout,*) '      Timor Passage ' 
    438434         ii0 =  56           ;   ii1 =  56        ! Timor Passage  
    439          ij0 = 124 + isrow   ;   ij1 = 125 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     435         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    440436 
    441437         IF(lwp) WRITE(numout,*) '      West Halmahera ' 
    442438         ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait  
    443          ij0 = 141 + isrow   ;   ij1 = 142 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
     439         ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    444440 
    445441         IF(lwp) WRITE(numout,*) '      East Halmahera ' 
    446442         ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait  
    447          ij0 = 141 + isrow   ;   ij1 = 142 + isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
     443         ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    448444         ! 
    449445      ENDIF 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5449 r5535  
    11231123      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    11241124         !                                             ! ===================== 
    1125          ! This dirty section will be suppressed by simplification process: all this will come back in input files 
    1126          ! Currently these hard-wired indices relate to the original (pre-v3.6) configuration  
     1125         ! This dirty section will be suppressed by simplification process: 
     1126         ! all this will come back in input files 
     1127         ! Currently these hard-wired indices relate to configuration with 
     1128         ! extend grid (jpjglo=332) 
    11271129         ! which had a grid-size of 362x292. 
    1128          ! This grid has been extended southwards for use with the under ice-shelf options (isf) introduced in v3.6.  
    1129          ! The original domain can still be used optionally if the isf code is not activated.  
    1130          ! An adjustment (isrow) is made to the hard-wired indices if the extended domain (362x332) is being used. 
    1131          !  
    1132          IF    ( jpjglo == 292 ) THEN  ;  isrow = 0  ! Using pre-v3.6 files or adjusted start row from isf-extended grid 
    1133          ELSEIF( jpjglo == 332 ) THEN  ;  isrow = 40 ! Using full isf­extended domain.  
    1134          ENDIF      
     1130         isrow = 332 - jpjglo 
    11351131         ! 
    11361132         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u was modified) 
    1137          ij0 = 201 + isrow   ;   ij1 = 201 + isrow 
     1133         ij0 = 241 - isrow   ;   ij1 = 241 - isrow 
    11381134         DO jk = 1, jpkm1 
    11391135            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11561152         ! 
    11571153         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u was modified) 
    1158          ij0 = 208 + isrow   ;   ij1 = 208 + isrow 
     1154         ij0 = 248 - isrow   ;   ij1 = 248 - isrow 
    11591155         DO jk = 1, jpkm1 
    11601156            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11771173         ! 
    11781174         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v was modified) 
    1179          ij0 = 124 + isrow   ;   ij1 = 125 + isrow 
     1175         ij0 = 164 - isrow   ;   ij1 = 165 - isrow 
    11801176         DO jk = 1, jpkm1 
    11811177            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11931189         ! 
    11941190         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 
    1195          ij0 = 124 + isrow   ;   ij1 = 125 + isrow 
     1191         ij0 = 164 - isrow   ;   ij1 = 165 - isrow 
    11961192         DO jk = 1, jpkm1 
    11971193            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12091205         ! 
    12101206         ii0 =  53          ;   ii1 =  53        ! Ombai Strait (e1v was modified) 
    1211          ij0 = 124 + isrow  ;   ij1 = 125  + isrow   
     1207         ij0 = 164 - isrow  ;   ij1 = 165  - isrow   
    12121208         DO jk = 1, jpkm1 
    12131209            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12241220         END DO 
    12251221         ! 
    1226          ii0 =  56             ;   ii1 =  56        ! Timor Passage (e1v was modified) 
    1227          ij0 = 124  + isrow    ;   ij1 = 125  + isrow   
     1222         ii0 =  56            ;   ii1 =  56        ! Timor Passage (e1v was modified) 
     1223         ij0 = 164 - isrow    ;   ij1 = 165  - isrow   
    12281224         DO jk = 1, jpkm1 
    12291225            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12401236         END DO 
    12411237         ! 
    1242          ii0 =  55             ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
    1243          ij0 = 141  + isrow    ;   ij1 = 142  + isrow   
     1238         ii0 =  55            ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
     1239         ij0 = 181 - isrow    ;   ij1 = 182 - isrow   
    12441240         DO jk = 1, jpkm1 
    12451241            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12561252         END DO 
    12571253         ! 
    1258          ii0 =  58             ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
    1259          ij0 = 141  + isrow    ;   ij1 = 142  + isrow   
     1254         ii0 =  58            ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
     1255         ij0 = 181 - isrow    ;   ij1 = 182 - isrow   
    12601256         DO jk = 1, jpkm1 
    12611257            DO jj = mj0(ij0), mj1(ij1) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5449 r5535  
    484484            CALL iom_close( inum ) 
    485485            mbathy(:,:) = INT( bathy(:,:) ) 
    486             ! 
    487             ! CL :  add Amazon deeper 
    488             IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration  
    489                  ii0 = 230   ;   ii1 = 245                   ! Amazon area  
    490                  ij0 = 140   ;   ij1 = 155                   ! no ocean shallower than 30 meters 
    491                  DO ji = mi0(ii0), mi1(ii1) 
    492                     DO jj = mj0(ij0), mj1(ij1) 
    493                        IF( bathy(ji,jj) .LE. 30. .AND. bathy(ji,jj) .GT. 0.0 ) bathy(ji,jj) = 30._wp 
    494                     END DO 
    495                  END DO 
    496                  IF(lwp) WRITE(numout,*) 
    497                  IF(lwp) WRITE(numout,*) '             orca_r1: Amazon area not shallower than 30 meters for: ' 
    498                  IF(lwp) WRITE(numout,*) '                    Longitude index ',ii0, ii0 
    499                  IF(lwp) WRITE(numout,*) '                    Latitude index  ',ij0, ij0 
    500             ENDIF 
    501486            !                                                ! ===================== 
    502487            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5449 r5535  
    237237      ! 
    238238      CALL wrk_dealloc( jpi  , jpj+2, zwu               ) 
    239       CALL wrk_dealloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
     239      CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 ) 
    240240      ! 
    241241      IF( nn_timing == 1 )  CALL timing_stop('div_cur') 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r5307 r5535  
    266266               ! Add volume filter correction: compatibility with tracer advection scheme 
    267267               ! => time filter + conservation correction (only at the first level) 
    268                fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
    269             ! 
     268               fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 
     269                              &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
    270270            ENDIF 
    271271            ! 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5307 r5535  
    2121   USE domvvl          ! Variable volume 
    2222   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    23    USE iom             ! I/O library 
    2423   USE restart         ! only for lrst_oce 
    2524   USE in_out_manager  ! I/O manager 
    … …  
    3130   USE bdy_par          
    3231   USE bdydyn2d        ! bdy_ssh routine 
    33    USE iom 
    3432#if defined key_agrif 
    3533   USE agrif_opa_update 
    … …  
    137135      !                                           !           outputs            ! 
    138136      !                                           !------------------------------! 
    139       CALL iom_put( "ssh" , sshn )   ! sea surface height 
    140       if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    141137      ! 
    142138      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 ) 
    … …  
    228224#endif 
    229225      ! 
    230       !                                           !------------------------------! 
    231       !                                           !           outputs            ! 
    232       !                                           !------------------------------! 
    233       CALL iom_put( "woce", wn )   ! vertical velocity 
    234       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    235          CALL wrk_alloc( jpi, jpj, z2d )  
    236          CALL wrk_alloc( jpi, jpj, jpk, z3d )  
    237          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    238          z2d(:,:) = rau0 * e12t(:,:) 
    239          DO jk = 1, jpk 
    240             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
    241          END DO 
    242          CALL iom_put( "w_masstr" , z3d )   
    243          IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    244          CALL wrk_dealloc( jpi, jpj, z2d  )  
    245          CALL wrk_dealloc( jpi, jpj, jpk, z3d )  
    246       ENDIF 
    247       ! 
    248226      IF( nn_timing == 1 )  CALL timing_stop('wzv') 
    249227 
    … …  
    290268      ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
    291269         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered 
    292          IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) ) * ssmask(:,:) 
     270         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:) 
    293271         sshn(:,:) = ssha(:,:)                           ! now <-- after 
    294272      ENDIF 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5449 r5535  
    9090   INTEGER ::   nitrst                !: time step at which restart file should be written 
    9191   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    92    INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write) 
     92   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
     93   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
    9394   INTEGER ::   nrst_lst              !: number of restart to output next 
    9495 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5449 r5535  
    663663 
    664664      ! --- evaporation minus precipitation --- ! 
     665      zsnw(:,:) = 0._wp 
    665666      CALL lim_thd_snwblow( pfrld, zsnw )          ! snow redistribution by wind 
    666667      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5449 r5535  
    613613 
    614614      ! --- evaporation minus precipitation --- ! 
     615      zsnw(:,:) = 0._wp 
    615616      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing  
    616617      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5449 r5535  
    780780      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
    781781      ! 
    782       ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) 
     782      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 
    783783      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   & 
    784784         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    … …  
    13791379      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
    13801380      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
    1381       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ! for LIM3 
     1381      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 
    13821382      !!---------------------------------------------------------------------- 
    13831383      ! 
    … …  
    15241524 
    15251525      ! --- heat flux associated with emp --- ! 
     1526      zsnw(:,:) = 0._wp 
    15261527      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
    15271528      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
    … …  
    15561557 
    15571558      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
    1558  
    15591559#else 
    15601560 
    … …  
    16241624         ENDDO 
    16251625      ENDIF 
     1626 
     1627#if defined key_lim3 
     1628      CALL wrk_alloc( jpi,jpj, zqsr_oce )  
     1629      ! --- solar flux over ocean --- ! 
     1630      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1631      zqsr_oce = 0._wp 
     1632      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 
     1633 
     1634      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
     1635      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF 
     1636 
     1637      CALL wrk_dealloc( jpi,jpj, zqsr_oce )  
     1638#endif 
    16261639 
    16271640      IF( ln_mixcpl ) THEN 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r5451 r5535  
    509509      CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 
    510510 
    511       CALL wrk_dealloc( jpi,jpj, ztmp ) 
     511      CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) 
    512512      CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 
    513513      ! 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5449 r5535  
    216216            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    217217                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     218            ! clem: evap_ice is forced to 0 in coupled mode for now  
     219            !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models 
     220            evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp 
    218221            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    219             ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 
    220             evap_ice  (:,:,:) = 0._wp 
    221             devap_ice (:,:,:) = 0._wp 
    222222         END SELECT 
    223223         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5449 r5535  
    5353   USE timing           ! Timing 
    5454   USE sbcwave          ! Wave module 
     55   USE bdy_par          ! Require lk_bdy 
    5556 
    5657   IMPLICIT NONE 
    … …  
    343344      !                                            ! ---------------------------------------- ! 
    344345      ! 
    345       IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
     346      IF ( .NOT. lk_bdy ) then 
     347         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
     348      ENDIF 
    346349                                                         ! (caution called before sbc_ssm) 
    347350      ! 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5449 r5535  
    209209      zfact = 0.5_wp 
    210210      ! 
    211       IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==! 
     211      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    212212         IF( lk_vvl ) THEN             ! variable volume case 
    213213            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90

    r5451 r5535  
    112112   INTEGER         :: nn_trc_ord = 1          ! order of autoregressive processes 
    113113 
    114    ! Public array with density correction 
    115    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: drho_ran 
    116  
    117114   !!---------------------------------------------------------------------- 
    118115   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    263260      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    264261 
    265       IF ( lk_agrif ) CALL ctl_stop('EOS stochastic parametrization is not compatible with AGRIF') 
    266262      ! Read namsto namelist : stochastic parameterization 
    267263      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    … …  
    341337      ENDIF 
    342338      IF( ln_sto_eos ) THEN 
     339         IF ( lk_agrif ) CALL ctl_stop('EOS stochastic parametrization is not compatible with AGRIF') 
    343340         IF(lwp) WRITE(numout,*) '       - stochastic equation of state' 
    344341         ALLOCATE(jsto_eosi(nn_sto_eos)) 
    … …  
    668665      ! ------------------------------------------ 
    669666      IF( ln_rststo ) CALL sto_rst_read 
    670  
    671       ! Allocate drho_ran 
    672       ALLOCATE(drho_ran(jpi,jpj,jpk)) 
    673667 
    674668   END SUBROUTINE sto_par_init 
    … …  
    781775               CALL iom_rstput( kt, nitrst, numstow, clsto3d , sto3d(:,:,:,jsto) ) 
    782776            END DO 
    783             ! Save drho_ran in restart file 
    784             CALL iom_rstput( kt, nitrst, numstow, 'drho' , drho_ran(:,:,:) ) 
    785777            ! close the restart file 
    786778            CALL iom_close( numstow ) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5449 r5535  
    2727   USE dom_oce         ! ocean space and time domain variables  
    2828   USE sbc_oce         ! surface boundary condition: ocean 
     29   USE sbcrnf          ! river runoffs 
    2930   USE zdf_oce         ! ocean vertical mixing 
    3031   USE domvvl          ! variable volume 
    … …  
    278279 
    279280      !!      
    280       LOGICAL  ::   ll_tra_hpg, ll_traqsr   ! local logical 
     281      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical 
    281282      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    282283      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
    … …  
    293294         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg 
    294295         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
     296         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
    295297      ELSE                           
    296298         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    297299         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
     300         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs 
    298301      ENDIF 
    299302      ! 
    … …  
    319322                  ! 
    320323                  IF( jk == 1 ) THEN           ! first level  
    321                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 
     324                     ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) ) 
    322325                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
    323326                  ENDIF 
     327 
    324328                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only) 
    325329                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )  
    326330 
    327                    ze3t_f = 1.e0 / ze3t_f 
    328                    ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
    329                    ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta 
    330                    ! 
    331                    IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only) 
    332                       ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
    333                       pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
    334                    ENDIF 
     331                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &            ! river runoffs 
     332                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
     333                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 
     334 
     335                  ze3t_f = 1.e0 / ze3t_f 
     336                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
     337                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta 
     338                  ! 
     339                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only) 
     340                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
     341                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
     342                  ENDIF 
    335343               END DO 
    336344            END DO 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5449 r5535  
    101101      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    102102      IF( lk_tide    )   CALL sbc_tide( kstp ) 
    103       IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    104  
     103      IF( lk_bdy     )  THEN 
     104         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib  
     105                         CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
     106      ENDIF 
    105107                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    106108                                                      ! clem: moved here for bdy ice purpose 
    107  
    108109      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    109110      ! Update stochastic parameters and random T/S fluctuations 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5449 r5535  
    2727   USE sbc_oce          ! surface boundary condition: ocean 
    2828   USE sbctide          ! Tide initialisation 
     29   USE sbcapr           ! surface boundary condition: ssh_ib required by bdydta  
    2930 
    3031   USE traqsr           ! solar radiation penetration      (tra_qsr routine) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r5451 r5535  
    121121 
    122122   LOGICAL ::   linit = .FALSE. 
     123   LOGICAL ::   ldebug = .FALSE. 
    123124   !!---------------------------------------------------------------------- 
    124125   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    … …  
    486487       
    487488      IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch  
     489         IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype 
    488490         tree(ii)%itype = itype                                        ! define the type of this branch  
    489491         tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch  
    … …  
    515517         tree(ii)%current%next%in_use = .FALSE.                        ! this leaf is not yet used 
    516518         tree(ii)%current%next%indic = tree(ii)%current%indic + 1      ! number of this leaf 
     519         IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic 
    517520         tree(ii)%current%next%prev => tree(ii)%current                ! previous leaf of the new leaf is the current leaf 
    518521         tree(ii)%current%next%next => NULL()                          ! next leaf is not yet defined 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r5451 r5535  
    8080      ndt05   = NINT(0.5 * rdttra(1)) 
    8181 
    82       ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
    83       ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
    84       adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    85       IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 
    86       ! 
    87       IF(lwp) THEN 
    88          WRITE(numout,*) ' *** Info used values : ' 
    89          WRITE(numout,*) '   date ndastp                                      : ', ndastp 
    90          WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
    91          WRITE(numout,*) 
    92       ENDIF 
     82      ! ==> clem: here we read the ocean restart for the date (only if it exists) 
     83      !           It is not clean and another solution should be found 
     84      CALL day_rst( nit000, 'READ' ) 
     85      ! ==> 
    9386 
    9487      ! set the calendar from ndastp (read in restart file and namelist) 
    … …  
    285278      ! 
    286279   END SUBROUTINE day 
     280 
     281 
     282   SUBROUTINE day_rst( kt, cdrw ) 
     283      !!--------------------------------------------------------------------- 
     284      !!                   ***  ROUTINE ts_rst  *** 
     285      !! 
     286      !!  ** Purpose : Read or write calendar in restart file: 
     287      !! 
     288      !!  WRITE(READ) mode: 
     289      !!       kt        : number of time step since the begining of the experiment at the 
     290      !!                   end of the current(previous) run 
     291      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the 
     292      !!                   end of the current(previous) run (REAL -> keep fractions of day) 
     293      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer) 
     294      !! 
     295      !!   According to namelist parameter nrstdt, 
     296      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary). 
     297      !!       nrstdt = 1  we verify that nit000 is equal to the last 
     298      !!                   time step of previous run + 1. 
     299      !!       In both those options, the  exact duration of the experiment 
     300      !!       since the beginning (cumulated duration of all previous restart runs) 
     301      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt. 
     302      !!       This is valid is the time step has remained constant. 
     303      !! 
     304      !!       nrstdt = 2  the duration of the experiment in days (adatrj) 
     305      !!                    has been stored in the restart file. 
     306      !!---------------------------------------------------------------------- 
     307      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     308      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     309      ! 
     310      REAL(wp) ::   zkt, zndastp 
     311      !!---------------------------------------------------------------------- 
     312 
     313      IF( TRIM(cdrw) == 'READ' ) THEN 
     314 
     315         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 
     316            ! Get Calendar informations 
     317            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run 
     318            IF(lwp) THEN 
     319               WRITE(numout,*) ' *** Info read in restart : ' 
     320               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
     321               WRITE(numout,*) ' *** restart option' 
     322               SELECT CASE ( nrstdt ) 
     323               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000' 
     324               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
     325               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart' 
     326               END SELECT 
     327               WRITE(numout,*) 
     328            ENDIF 
     329            ! Control of date 
     330            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         & 
     331                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
     332                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
     333            ! define ndastp and adatrj 
     334            IF ( nrstdt == 2 ) THEN 
     335               ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 
     336               CALL iom_get( numror, 'ndastp', zndastp ) 
     337               ndastp = NINT( zndastp ) 
     338               CALL iom_get( numror, 'adatrj', adatrj  ) 
     339            ELSE 
     340               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
     341               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     342               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     343               ! note this is wrong if time step has changed during run 
     344            ENDIF 
     345         ELSE 
     346            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
     347            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     348            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     349         ENDIF 
     350         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 
     351         ! 
     352         IF(lwp) THEN 
     353            WRITE(numout,*) ' *** Info used values : ' 
     354            WRITE(numout,*) '   date ndastp                                      : ', ndastp 
     355            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
     356            WRITE(numout,*) 
     357         ENDIF 
     358         ! 
     359      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     360         ! 
     361         IF( kt == nitrst ) THEN 
     362            IF(lwp) WRITE(numout,*) 
     363            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt 
     364            IF(lwp) WRITE(numout,*) '~~~~~~~' 
     365         ENDIF 
     366         ! calendar control 
     367         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step 
     368         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date 
     369         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
     370         !                                                                     ! the begining of the run [s] 
     371      ENDIF 
     372      ! 
     373   END SUBROUTINE day_rst 
    287374   !!====================================================================== 
    288375END MODULE daymod 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r5451 r5535  
    5959   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
    6060   USE icbstp          ! handle bergs, calving, themodynamics and transport 
     61#if defined key_bdy 
     62   USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3 
     63   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3 
     64#endif 
     65   USE bdy_par 
    6166 
    6267   IMPLICIT NONE 
    … …  
    354359 
    355360                            CALL sbc_init   ! Forcings : surface module  
     361                             
     362      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from   
     363      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.  
     364      !           This is not clean and should be changed in the future.  
     365      IF( lk_bdy        )   CALL     bdy_init 
     366      IF( lk_bdy        )   CALL bdy_dta_init 
     367      ! ==> 
    356368       
    357369      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    … …  
    502514      USE diawri    , ONLY: dia_wri_alloc 
    503515      USE dom_oce   , ONLY: dom_oce_alloc 
    504       USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
     516#if defined key_bdy    
     517      USE bdy_oce   , ONLY: bdy_oce_alloc 
     518      USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays 
     519#else 
     520      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     521#endif 
    505522      ! 
    506523      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 
    … …  
    510527      ierr =        dia_wri_alloc   () 
    511528      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    512       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    513          &      snwice_fmass(jpi,jpj), STAT= ierr1 ) 
     529#if defined key_bdy 
     530      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization) 
     531      ierr = ierr + oce_alloc       ()          ! (tsn...) 
     532#endif 
     533 
     534#if ! defined key_bdy 
     535       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
     536         &      snwice_fmass(jpi,jpj)  , STAT= ierr1 ) 
    514537      ! 
    515538      ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
    516       ! and ub, vb arrays in ice dynamics 
    517       ! so allocate enough of arrays to use 
    518       ! 
     539      ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use 
     540      ! clem: should not be needed. To be checked out 
    519541      jpm = MAX(jp_tem, jp_sal) 
    520542      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 ) 
    … …  
    523545      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
    524546      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
    525  
    526547      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  
     548#endif 
    527549      ! 
    528550      IF( lk_mpp    )   CALL mpp_sum( ierr ) 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/SAS_SRC/step.F90

    r5451 r5535  
    3737 
    3838   USE timing           ! Timing             
     39 
     40   USE bdy_par          ! clem: mandatory for LIM3 
     41#if defined key_bdy 
     42   USE bdydta           ! clem: mandatory for LIM3 
     43#endif 
    3944 
    4045   IMPLICIT NONE 
    … …  
    8186                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp 
    8287 
     88      ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from   
     89      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 
     90      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.   
     91      !           This is not clean and should be changed in the future.  
     92#if defined key_bdy 
     93      IF( lk_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
     94#endif 
     95      ! ==> 
    8396                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    8497 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r5451 r5535  
    117117         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
    118118            CALL fld_read( kt, 1, sf_dust ) 
    119             dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     119            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 
     120               dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     121            ELSE 
     122               dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 
     123            ENDIF 
    120124         ENDIF 
    121125      ENDIF 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5451 r5535  
    185185      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    186186      ! 
    187       INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa 
     187      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
     188      INTEGER :: isrow                                      ! local index 
    188189      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    189190 
    … …  
    201202            ! 
    202203            SELECT CASE ( jp_cfg ) 
     204            !                                           ! ======================= 
     205            CASE ( 1 )                                  ! eORCA_R1 configuration 
     206            !                                           ! ======================= 
     207            isrow = 332 - jpjglo 
     208            ! 
     209                                                        ! Caspian Sea 
     210            nctsi1(1)   = 332  ; nctsj1(1)   = 243 - isrow 
     211            nctsi2(1)   = 344  ; nctsj2(1)   = 275 - isrow 
     212            !                                         
    203213            !                                           ! ======================= 
    204214            CASE ( 2 )                                  !  ORCA_R2 configuration 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r5449 r5535  
    207207         ENDIF 
    208208 
    209          CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 
    210  
    211          CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
    212  
    213          IF(lwp) THEN 
    214             WRITE(numout,*) ' *** Info read in restart : ' 
    215             WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
    216             WRITE(numout,*) ' *** restart option' 
    217             SELECT CASE ( nn_rsttr ) 
    218             CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
    219             CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
    220             CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    221             END SELECT 
    222             WRITE(numout,*) 
    223          ENDIF 
    224          ! Control of date  
    225          IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
    226             &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    227             &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    228          IF( lk_offline ) THEN      ! set the date in offline mode 
    229             ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
    230             IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN 
    231                CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 ) 
    232                IF( zrdttrc1 /= rdt * nn_dttrc )   neuler = 0 
    233             ENDIF 
    234             !                          ! define ndastp and adatrj 
    235             IF( nn_rsttr == 2 ) THEN 
     209         IF( ln_rsttr ) THEN 
     210            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     211            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
     212 
     213            IF(lwp) THEN 
     214               WRITE(numout,*) ' *** Info read in restart : ' 
     215               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
     216               WRITE(numout,*) ' *** restart option' 
     217               SELECT CASE ( nn_rsttr ) 
     218               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
     219               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
     220               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
     221               END SELECT 
     222               WRITE(numout,*) 
     223            ENDIF 
     224            ! Control of date  
     225            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     226               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
     227               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
     228         ENDIF 
     229         ! 
     230         IF( lk_offline ) THEN     
     231            !                                          ! set the date in offline mode 
     232            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN 
    236233               CALL iom_get( numrtr, 'ndastp', zndastp )  
    237234               ndastp = NINT( zndastp ) 
    238235               CALL iom_get( numrtr, 'adatrj', adatrj  ) 
    239             ELSE 
     236             ELSE 
    240237               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    241238               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
    … …  
    248245              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
    249246              WRITE(numout,*) 
     247            ENDIF 
     248            ! 
     249            IF( ln_rsttr )  THEN   ;    neuler = 1 
     250            ELSE                   ;    neuler = 0 
    250251            ENDIF 
    251252            ! 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/SETTE/prepare_job.sh

    r4814 r5535  
    226226                                        # round up the number of nodes required. 
    227227                                        # 
    228                                         NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}')                     
     228                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}')  
     229                                fi 
     230                                ;; 
     231                        XC40_METO*) #Setup for Met Office XC40 with any compiler 
     232                                # ocean cores are packed 32 to a node 
     233                                # If we need more than one node then have to use parallel queue and XIOS must have a node to itself 
     234                                NB_REM=$( echo $NB_PROC | awk '{print ( $1 % 32 ) }') 
     235                                if [ ${NB_REM} == 0 ] ; then 
     236                                        # number of processes required is an integer multiple of 32 
     237                                        # 
     238                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1) / 32}') 
     239                                else 
     240                                        # 
     241                                        # number of processes required is not an integer multiple of 32 
     242                                        # round up the number of nodes required. 
     243                                        # 
     244                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1) / 32 + 1 )}') 
     245                                fi 
     246                                # xios cores are sparsely packed at 4 to a node 
     247                                if [ $NXIO_PROC == 0 ] ; then 
     248                                    NB_XNODES=0 
     249                                else 
     250                                    NB_REM=$( echo $NXIO_PROC | awk '{print ( $1 % 4 ) }') 
     251                                    if [ ${NB_REM} == 0 ] ; then 
     252                                            # number of processes required is an integer multiple of 4                            
     253                                            # 
     254                                            NB_XNODES=$( echo $NXIO_PROC | awk '{print (( $1 / 4 ) + 1)}')  
     255                                    else 
     256                                            # 
     257                                            # number of processes required is not an integer multiple of 4                              
     258                                            # round up the number of nodes required. 
     259                                            # 
     260                                            NB_XNODES=$( echo $NXIO_PROC | awk '{printf("%d",($1) / 4 + 1) }')                     
     261                                    fi 
     262                                fi 
     263                                if [ ${NB_XNODES} -ge 1 ] ; then 
     264                                   NB_NODES=$((NB_NODES+NB_XNODES)) 
     265                                fi 
     266                                echo NB_XNODES=${NB_XNODES}  
     267                                echo Total NB_NODES=${NB_NODES} 
     268                                if [ ${NB_NODES} -eq 1 ] ; then 
     269                                   QUEUE=shared 
     270                                   #Not using XIOS in detatched mode and using less than one node so should be ok on shared node 
     271                                   #Load snplauncher module to allow use of mpiexec 
     272                                   SELECT="select=1:ncpus=$((NXIO_PROC + NB_PROC))":mem=15GB 
     273                                   module load cray-snplauncher 
     274                                   echo 'Shared Queue' 
     275                                else 
     276                                   QUEUE=normal 
     277                                   SELECT="select=$NB_NODES" 
     278                                   module unload cray-snplauncher #Make sure snplauncher module is not loaded 
     279                                   echo 'Normal Queue' 
    229280                                fi 
    230281                                ;; 
    … …  
    279330                    cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" \ 
    280331                                                 -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job 
     332                    mv run_sette_test1.job run_sette_test.job 
     333                    ;; 
     334              XC40_METO*) 
     335                    cat run_sette_test.job | sed -e"s/QUEUE/${QUEUE}/" \ 
     336                                                 -e"s/SELECT/${SELECT}/" > run_sette_test1.job 
    281337                    mv run_sette_test1.job run_sette_test.job 
    282338                    ;; 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/SETTE/sette.sh

    r5449 r5535  
    857857    export TEST_NAME="REPRO_4_8" 
    858858    . ./prepare_exe_dir.sh 
     859    JOB_FILE=${EXE_DIR}/run_job.sh 
     860    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    859861    cd ${EXE_DIR} 
    860862    set_namelist namelist_cfg nn_it000 1 

  • branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh

    r5449 r5535  
    1818for ff in $( grep -il "^ *use  *wrk_nemo" $( find . -name "*90" )  $( find . -name "*h90" ) ) 
    1919do 
     20    ierr=0 
     21     
    2022    # number of lines with wrk_alloc 
    2123    n1=$( grep -ic "call *wrk_alloc *(" $ff ) 
    … …  
    2830   n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" ) 
    2931   # we should get n2 = 2 * n1... 
    30    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff"  
    31     
     32   if [ $(( 2 * $n1 )) -ne $n2 ] 
     33   then 
     34       ierr=1 
     35       echo "problem with wrk_alloc in $ff"  
     36   fi 
    3237   # same story but for wrk_dealloc 
    3338   nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 
    3439   if [ $(( 2 * $nn1 )) -ne $nn2 ] 
    3540   then 
    36        echo "problem with wrk_dealloc in $ff" 
     41       ierr=1 
     42       echo "problem with wrk_dealloc in $ff"  
     43   fi 
     44 
     45   if [ $ierr -eq 0 ] # check that wrk_alloc block is the same as wrk_dealloc block 
     46   then 
     47       grep -i "call *wrk_alloc *("   $ff | sed -e "s/ //g" | sed -e "s/!.*//g" > txt1$$ 
     48       grep -i "call *wrk_dealloc *(" $ff | sed -e "s/wrk_dealloc/wrk_alloc/"  | sed -e "s/ //g" | sed -e "s/!.*//g" > txt2$$ 
     49       cmp txt1$$ txt2$$ 
     50       if [ $? -ne 0 ] 
     51       then 
     52      echo "different syntax in wrk_alloc and wrk_dealloc in $ff" 
     53      echo 
     54      for ll in $( seq 1 $n1 )  # compare each line 
     55      do 
     56          sed -n ${ll}p txt1$$ > ll1$$ 
     57          sed -n ${ll}p txt2$$ > ll2$$ 
     58          cmp ll1$$ ll2$$ > /dev/null 
     59          if [ $? -ne 0 ] 
     60          then 
     61         grep -i "call *wrk_alloc *("   $ff | sed -n ${ll}p 
     62         grep -i "call *wrk_dealloc *(" $ff | sed -n ${ll}p 
     63         echo 
     64          fi 
     65          rm -f ll1$$ ll2$$ 
     66      done 
     67       fi 
     68       rm -f txt1$$ txt2$$ 
     69   else 
    3770       grep -i "call *wrk_alloc *(" $ff 
    38        grep -i "call *wrk_dealloc *(" $ff 
     71       echo 
     72       grep -i "call *wrk_dealloc *(" $ff  
    3973       echo 
    4074   fi 
     75    
    4176    fi 
    4277     
Note: See TracChangeset for help on using the changeset viewer.