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

Changeset 8973


Ignore:
Timestamp:
2017-12-11T13:51:34+01:00 (5 years ago)
Author:
jchanut
Message:

Merge Mercator's development with trunk - #1993

Location:
branches/2017/dev_MERCATOR_2017
Files:
36 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_MERCATOR_2017/DOC/Namelists/nam_tide

    r7646 r8973  
    22&nam_tide      !   tide parameters 
    33!----------------------------------------------------------------------- 
    4    ln_tide       = .true.   !  Activate tide module 
    5    ln_tide_pot   = .true.   !  use tidal potential forcing 
    6    ln_tide_ramp  = .false.  ! 
    7    rdttideramp   =    0.    ! 
    8    clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg 
     4   ln_tide       = .true.                ! Activate tides 
     5      ln_tide_pot   = .true.                !  use tidal potential forcing 
     6         ln_scal_load  = .false.               ! Use scalar approximation for 
     7            rn_scal_load = 0.094               !     load potential 
     8         ln_read_load  = .false.               ! Or read load potential from file 
     9            cn_tide_load = 'tide_LOAD_grid_T.nc'  ! filename for load potential 
     10            ! 
     11      ln_tide_ramp  = .false.               !  Use linear ramp for tides at startup 
     12         rdttideramp   =    0.                 !  ramp duration in days 
     13      clname(1)     = 'DUMMY'               !  name of constituent - all tidal components must be set in namelist_cfg 
    914/ 

  • branches/2017/dev_MERCATOR_2017/DOC/TexFiles/Bibliography/Biblio.bib

    r7646 r8973  
    134134  author = {Arakawa, Akio and Lamb, Vivian R.}, 
    135135  title = {A Potential Enstrophy and Energy Conserving Scheme for the Shallow 
    136    Water Equations}, 
     136           Water Equations}, 
    137137  journal = MWR, 
    138138  year = {1981}, 
    … …  
    140140  pages = {18--36} 
    141141} 
     142 
     143@ARTICLE{Arbic2010, 
     144  author = {Arbic, Wallcraft, Metzger}, 
     145  title = {Concurrent simulation of the eddying general circulation and tides in a global ocean model}, 
     146  journal = OM, 
     147  year = {2010}, 
     148  volume = {32},  number = {3-4}, 
     149  pages = {175-187} 
    142150 
    143151@ARTICLE{Arhan2006, 

  • branches/2017/dev_MERCATOR_2017/DOC/TexFiles/Chapters/Chap_SBC.tex

    r7646 r8973  
    780780Some parameters are available in namelist \ngn{nam\_tide}: 
    781781 
     782- \np{ln\_tide\_load} activate the load potential forcing and \np{filetide_load} is  the associated file  
     783 
    782784- \np{ln\_tide\_pot} activate the tidal potential forcing 
    783785 
    … …  
    815817with $k$ a number of Love estimated to 0.6 which parameterised the astronomical tidal land, 
    816818and $h$ a number of Love to 0.3 which parameterised the parameterisation due to the astronomical tidal land. 
     819 
     820A description of load potential can be found in  \citet{Arbic2010} 
    817821 
    818822% ================================================================ 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm

    r6140 r8973  
    2323%CPP               cpp 
    2424%FC                  mpif90 
    25 %FCFLAGS             -O2 -fp-model precise  -traceback -r8  -convert big_endian -assume byterecl 
     25%FCFLAGS             -O1 -fp-model precise  -traceback -r8  -convert big_endian -assume byterecl 
    2626%FFLAGS              %FCFLAGS 
    2727%LD                   mpif90 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg

    r8284 r8973  
    2222&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    2323!-----------------------------------------------------------------------   
    24    ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     24   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    2525   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
    2626   ! 
    … …  
    8585&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    8686!----------------------------------------------------------------------- 
    87    nn_cln_update =    1    !  baroclinic update frequency 
    8887/ 
    8988!----------------------------------------------------------------------- 
    … …  
    171170&namdyn_hpg    !   Hydrostatic pressure gradient option 
    172171!----------------------------------------------------------------------- 
     172   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation) 
    173173/ 
    174174!----------------------------------------------------------------------- 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg

    r8599 r8973  
    102102&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    103103!----------------------------------------------------------------------- 
    104    nn_cln_update =    3    !  baroclinic update frequency 
    105104/ 
    106105!----------------------------------------------------------------------- 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/CONFIG/SHARED/namelist_ref

    r8599 r8973  
    517517&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    518518!----------------------------------------------------------------------- 
    519    nn_cln_update =    3    !  baroclinic update frequency 
    520519   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    521520   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
    … …  
    526525&nam_tide      !   tide parameters 
    527526!----------------------------------------------------------------------- 
    528    ln_tide     = .false. 
    529    ln_tide_pot = .true.    !  use tidal potential forcing 
    530    ln_tide_ramp= .false.   ! 
    531    rdttideramp =    0.     ! 
    532    clname(1)   = 'DUMMY'   !  name of constituent - all tidal components must be set in namelist_cfg 
     527   ln_tide       = .false.                ! Activate tides 
     528      ln_tide_pot   = .true.                !  use tidal potential forcing 
     529         ln_scal_load  = .false.               ! Use scalar approximation for 
     530            rn_scal_load = 0.094               !     load potential 
     531         ln_read_load  = .false.               ! Or read load potential from file 
     532            cn_tide_load = 'tide_LOAD_grid_T.nc'  ! filename for load potential 
     533            !       
     534      ln_tide_ramp  = .false.               !  Use linear ramp for tides at startup 
     535         rdttideramp   =    0.                 !  ramp duration in days 
     536      clname(1)     = 'DUMMY'               !  name of constituent - all tidal components must be set in namelist_cfg 
    533537/ 
    534538!----------------------------------------------------------------------- 
    … …  
    835839         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed 
    836840         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds 
     841      rn_bt_alpha   = 0.         ! Temporal diffusion parameter (if ln_bt_av=F) 
    837842/ 
    838843!----------------------------------------------------------------------- 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/CONFIG/TEST_CASES/cfg.txt

    r7715 r8973  
    1 OVERFLOW OPA_SRC 
    21WAD OPA_SRC 
    32LOCK_EXCHANGE OPA_SRC 
    43SAS_BIPER OPA_SRC SAS_SRC LIM_SRC_3 NST_SRC 
    54ISOMIP OPA_SRC 
     5OVERFLOW OPA_SRC 
     6VORTEX OPA_SRC NST_SRC 
     7ISOMIP_LONG OPA_SRC 
     8ISOMIP_32 OPA_SRC 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90

    r5656 r8973  
    5959      Agrif_SpecialValueFineGrid = 0. 
    6060# if defined TWO_WAY 
    61       IF( MOD(nbcline,nbclineupdate) == 0) THEN 
    62          CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  ) 
    63          CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
    64          CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    ) 
    65       ELSE 
    66          CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  ) 
    67          CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
    68          CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
    69       ENDIF 
     61      CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  ) 
     62      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
     63      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    ) 
     64!      CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  ) 
     65!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
     66!      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
    7067# endif 
    7168      ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

    r7761 r8973  
    5959      Agrif_SpecialValueFineGrid = -9999. 
    6060# if defined TWO_WAY 
    61       IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 
    62                                                 ! nbcline is incremented (+1) at the end of each parent time step from 0 (1st time step) 
    63          CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  ) 
    64          CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
    65          CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    ) 
    66       ELSE                                      ! update only the boundaries defined par locupdate 
    67          CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  ) 
    68          CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
    69          CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
    70       ENDIF 
     61      CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  ) 
     62      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
     63      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    ) 
     64 
     65!      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  ) 
     66!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
     67!      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
    7168# endif 
    7269      Agrif_UseSpecialValueInUpdate = .FALSE. 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r5656 r8973  
    2020   !                                              !!* Namelist namagrif: AGRIF parameters 
    2121   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: 
    22    INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency  
    2322   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points) 
    2423   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
    2524   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2625   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry  
     26   LOGICAL , PUBLIC ::   lk_agrif_clp  = .FALSE.   !: Flag to retrieve clamped open boundaries 
    2727 
    2828   !                                              !!! OLD namelist names 
    29    INTEGER , PUBLIC ::   nbcline = 0               !: update counter 
    30    INTEGER , PUBLIC ::   nbclineupdate             !: update frequency  
    3129   REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers 
    3230   REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics 
    … …  
    3533   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator 
    3634   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step 
    37    LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE.     !: if true: send update from current grid 
    3835   LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info 
    3936 
    … …  
    6562   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 
    6663   INTEGER :: scales_t_id 
    67 # if defined key_zdftke 
     64# if defined key_zdftke || defined key_zdfgls 
    6865   INTEGER :: avt_id, avm_id, en_id 
    6966# endif   

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r7646 r8973  
    2424   USE agrif_oce 
    2525   USE phycst 
     26   USE dynspg_ts, ONLY: un_adv, vn_adv 
    2627   ! 
    2728   USE in_out_manager 
    … …  
    3839   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
    3940   PUBLIC   interpe3t, interpumsk, interpvmsk 
    40 # if defined key_zdftke 
    41    PUBLIC   Agrif_tke, interpavm 
     41# if defined key_zdftke || defined key_zdfgls 
     42   PUBLIC   Agrif_avm, interpavm 
    4243# endif 
    4344 
    … …  
    116117         ENDIF 
    117118         ! 
    118          DO jk=1,jpkm1                 ! Smooth 
    119             DO jj=j1,j2 
    120                ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
    121                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
    122             END DO 
    123          END DO 
     119         IF (.NOT.lk_agrif_clp) THEN 
     120            DO jk=1,jpkm1              ! Smooth 
     121               DO jj=j1,j2 
     122                  ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
     123                  ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
     124               END DO 
     125            END DO 
     126         END IF 
    124127         ! 
    125128         zub(2,:) = 0._wp              ! Correct transport 
    … …  
    185188         ENDIF 
    186189 
    187          DO jk = 1, jpkm1              ! Smooth 
    188             DO jj = j1, j2 
    189                ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
    190                   &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
    191             END DO 
    192          END DO 
     190         IF (.NOT.lk_agrif_clp) THEN 
     191            DO jk = 1, jpkm1           ! Smooth 
     192               DO jj = j1, j2 
     193                  ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
     194                     &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
     195               END DO 
     196            END DO 
     197         ENDIF 
    193198 
    194199         zub(nlci-2,:) = 0._wp        ! Correct transport 
    … …  
    254259         ENDIF 
    255260         ! 
    256          DO jk = 1, jpkm1              ! Smooth 
    257             DO ji = i1, i2 
    258                va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
    259                   &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
    260             END DO 
    261          END DO 
     261         IF (.NOT.lk_agrif_clp) THEN 
     262            DO jk = 1, jpkm1              ! Smooth 
     263               DO ji = i1, i2 
     264                  va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
     265                     &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
     266               END DO 
     267            END DO 
     268         ENDIF 
    262269         ! 
    263270         zvb(:,2) = 0._wp              ! Correct transport 
    … …  
    323330         ENDIF 
    324331         ! 
    325          DO jk = 1, jpkm1              ! Smooth 
    326             DO ji = i1, i2 
    327                va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
    328                   &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
    329             END DO 
    330          END DO 
     332         IF (.NOT.lk_agrif_clp) THEN 
     333            DO jk = 1, jpkm1           ! Smooth 
     334               DO ji = i1, i2 
     335                  va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
     336                     &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
     337               END DO 
     338            END DO 
     339         ENDIF 
    331340         ! 
    332341         zvb(:,nlcj-2) = 0._wp         ! Correct transport 
    … …  
    449458      INTEGER :: ji, jj 
    450459      LOGICAL :: ll_int_cons 
    451       REAL(wp) :: zrhot, zt 
    452460      !!----------------------------------------------------------------------   
    453461      ! 
    … …  
    456464      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only 
    457465      ! 
    458       zrhot = Agrif_rhot() 
    459       ! 
    460       ! "Central" time index for interpolation: 
    461       IF( ln_bt_fw ) THEN 
    462          zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot 
    463       ELSE 
    464          zt = REAL( Agrif_NbStepint()       , wp ) / zrhot 
    465       ENDIF 
    466       ! 
    467       ! Linear interpolation of sea level 
    468       Agrif_SpecialValue    = 0._wp 
    469       Agrif_UseSpecialValue = .TRUE. 
    470       CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn ) 
    471       Agrif_UseSpecialValue = .FALSE. 
     466      ! Enforce volume conservation if no time refinement:   
     467      IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.   
    472468      ! 
    473469      ! Interpolate barotropic fluxes 
    474       Agrif_SpecialValue=0. 
     470      Agrif_SpecialValue=0._wp 
    475471      Agrif_UseSpecialValue = ln_spc_dyn 
    476472      ! 
    … …  
    491487         ubdy_n(:) = 0._wp   ;   vbdy_n(:) = 0._wp  
    492488         ubdy_s(:) = 0._wp   ;   vbdy_s(:) = 0._wp 
    493          CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb ) 
    494          CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb ) 
     489         CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 
     490         CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) 
    495491      ENDIF 
    496492      Agrif_UseSpecialValue = .FALSE. 
    … …  
    501497   SUBROUTINE Agrif_ssh( kt ) 
    502498      !!---------------------------------------------------------------------- 
    503       !!                  ***  ROUTINE Agrif_DYN  *** 
     499      !!                  ***  ROUTINE Agrif_ssh  *** 
    504500      !!----------------------------------------------------------------------   
    505501      INTEGER, INTENT(in) ::   kt 
    506502      !! 
     503      INTEGER :: ji, jj 
    507504      !!----------------------------------------------------------------------   
    508505      ! 
    509506      IF( Agrif_Root() )   RETURN 
     507      !       
     508      ! Linear interpolation in time of sea level 
     509      ! 
     510      Agrif_SpecialValue    = 0._wp 
     511      Agrif_UseSpecialValue = .TRUE. 
     512      CALL Agrif_Bc_variable(sshn_id, procname=interpsshn ) 
     513      Agrif_UseSpecialValue = .FALSE. 
    510514      ! 
    511515      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    512          ssha(2,:)=ssha(3,:) 
    513          sshn(2,:)=sshn(3,:) 
     516         DO jj=1,jpj 
     517            ssha(2,jj) = hbdy_w(jj) 
     518         END DO 
    514519      ENDIF 
    515520      ! 
    516521      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    517          ssha(nlci-1,:)=ssha(nlci-2,:) 
    518          sshn(nlci-1,:)=sshn(nlci-2,:) 
     522         DO jj=1,jpj 
     523            ssha(nlci-1,jj) = hbdy_e(jj) 
     524         END DO 
    519525      ENDIF 
    520526      ! 
    521527      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    522          ssha(:,2)=ssha(:,3) 
    523          sshn(:,2)=sshn(:,3) 
     528         DO ji=1,jpi 
     529            ssha(ji,2) = hbdy_s(ji) 
     530         END DO 
    524531      ENDIF 
    525532      ! 
    526533      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    527          ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    528          sshn(:,nlcj-1)=sshn(:,nlcj-2) 
     534         DO ji=1,jpi 
     535            ssha(ji,nlcj-1) = hbdy_n(ji) 
     536         END DO 
    529537      ENDIF 
    530538      ! 
    … …  
    541549      !!----------------------------------------------------------------------   
    542550      ! 
     551      ! 
     552      IF( Agrif_Root() )   RETURN 
     553      ! 
    543554      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    544555         DO jj = 1, jpj 
    … …  
    567578   END SUBROUTINE Agrif_ssh_ts 
    568579 
    569 # if defined key_zdftke 
    570  
    571    SUBROUTINE Agrif_tke 
    572       !!---------------------------------------------------------------------- 
    573       !!                  ***  ROUTINE Agrif_tke  *** 
     580# if defined key_zdftke || defined key_zdfgls 
     581 
     582   SUBROUTINE Agrif_avm 
     583      !!---------------------------------------------------------------------- 
     584      !!                  ***  ROUTINE Agrif_avm  *** 
    574585      !!----------------------------------------------------------------------   
    575586      REAL(wp) ::   zalpha 
    576587      !!----------------------------------------------------------------------   
    577588      ! 
    578       zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 
    579       IF( zalpha > 1. )   zalpha = 1. 
     589      IF( Agrif_Root() )   RETURN 
     590      ! 
     591!      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 
     592!      IF( zalpha > 1. )   zalpha = 1. 
     593      zalpha = 1._wp ! JC: proper time interpolation impossible   
     594                     ! => use last available value from parent  
    580595      ! 
    581596      Agrif_SpecialValue    = 0.e0 
    … …  
    586601      Agrif_UseSpecialValue = .FALSE. 
    587602      ! 
    588    END SUBROUTINE Agrif_tke 
     603   END SUBROUTINE Agrif_avm 
    589604    
    590605# endif 
    … …  
    609624         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
    610625      ELSE 
     626         IF (lk_agrif_clp) THEN 
     627            DO jn = 1, jpts 
     628               DO jk = 1, jpkm1 
     629                  DO ji = i1,i2 
     630                     DO jj = j1,j2 
     631                        tsa(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) 
     632                     END DO 
     633                  END DO 
     634               END DO 
     635            END DO            
     636            return 
     637         ENDIF 
    611638         ! 
    612639         western_side  = (nb == 1).AND.(ndir == 1) 
    … …  
    781808      ! 
    782809      IF( before ) THEN  
    783          DO jk = k1, jpk 
     810         DO jk = 1, jpkm1 
    784811            ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
    785812         END DO 
    … …  
    788815         DO jk = 1, jpkm1 
    789816            DO jj=j1,j2 
    790                ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) ) 
     817               ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_a(i1:i2,jj,jk) ) 
    791818            END DO 
    792819         END DO 
    … …  
    808835      !!---------------------------------------------------------------------- 
    809836      !       
    810       IF( before ) THEN       !interpv entre 1 et k2 et interpv2d en jpkp1 
    811          DO jk = k1, jpk 
     837      IF( before ) THEN   
     838         DO jk = 1, jpkm1 
    812839            ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk) 
    813840         END DO 
    … …  
    815842         zrhox= Agrif_Rhox() 
    816843         DO jk = 1, jpkm1 
    817             va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) ) 
     844            va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_a(i1:i2,j1:j2,jk) ) 
    818845         END DO 
    819846      ENDIF 
    … …  
    9781005      !!----------------------------------------------------------------------   
    9791006      IF( before ) THEN 
    980          ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 
     1007         IF ( ln_bt_fw ) THEN 
     1008            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 
     1009         ELSE 
     1010            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 
     1011         ENDIF 
    9811012      ELSE 
    9821013         western_side  = (nb == 1).AND.(ndir == 1) 
    … …  
    10161047      ! 
    10171048      IF( before ) THEN 
    1018          ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
     1049         IF ( ln_bt_fw ) THEN 
     1050            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
     1051         ELSE 
     1052            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
     1053         ENDIF 
    10191054      ELSE       
    10201055         western_side  = (nb == 1).AND.(ndir == 1) 
    … …  
    11751210   END SUBROUTINE interpvmsk 
    11761211 
    1177 # if defined key_zdftke 
     1212# if defined key_zdftke || defined key_zdfgls 
    11781213 
    11791214   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 
    … …  
    11891224         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    11901225      ELSE 
    1191          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
     1226         avm  (i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
    11921227      ENDIF 
    11931228      ! 
    11941229   END SUBROUTINE interpavm 
    11951230 
    1196 # endif /* key_zdftke */ 
     1231# endif /* key_zdftke || key_zdfgls */ 
    11971232 
    11981233#else 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r7646 r8973  
    3838      ! 
    3939#if defined SPONGE 
    40       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     40!!      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     41!! Assume persistence: 
     42      timecoeff = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 
    4143 
    4244      CALL Agrif_Sponge 
    … …  
    6163 
    6264#if defined SPONGE 
    63       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     65!!      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     66!! Assume persistence: 
     67      timecoeff = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 
    6468 
    6569      Agrif_SpecialValue=0. 
    … …  
    207211      ! 
    208212      IF( before ) THEN 
    209          tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     213         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsb(i1:i2,j1:j2,k1:k2,n1:n2) 
    210214      ELSE    
    211215         ! 
    … …  
    276280      ! 
    277281      IF( before ) THEN 
    278          tabres = un(i1:i2,j1:j2,:) 
     282         tabres = ub(i1:i2,j1:j2,:) 
    279283      ELSE 
    280284         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 
    … …  
    373377 
    374378      IF( before ) THEN  
    375          tabres = vn(i1:i2,j1:j2,:) 
     379         tabres = vb(i1:i2,j1:j2,:) 
    376380      ELSE 
    377381         ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r7646 r8973  
    11#define TWO_WAY        /* TWO WAY NESTING */ 
    2 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 
     2#undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/ 
     3#undef VOL_REFLUX      /* VOLUME REFLUXING*/ 
    34  
    45MODULE agrif_opa_update 
    … …  
    1213   USE wrk_nemo   
    1314   USE zdf_oce        ! vertical physics: ocean variables  
     15   USE domvvl         ! Need interpolation routines  
    1416 
    1517   IMPLICIT NONE 
    1618   PRIVATE 
    1719 
    18    PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 
     20   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales, Agrif_Update_vvl, Agrif_Update_ssh 
     21 
    1922# if defined key_zdftke 
    2023   PUBLIC Agrif_Update_Tke 
    … …  
    2730CONTAINS 
    2831 
    29    RECURSIVE SUBROUTINE Agrif_Update_Tra( ) 
     32   SUBROUTINE Agrif_Update_Tra( ) 
    3033      !!--------------------------------------------- 
    3134      !!   *** ROUTINE Agrif_Update_Tra *** 
    … …  
    3538      ! 
    3639#if defined TWO_WAY   
    37       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline 
     40      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed() 
    3841 
    3942      Agrif_UseSpecialValueInUpdate = .TRUE. 
    4043      Agrif_SpecialValueFineGrid = 0. 
    4144      !  
    42       IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    4345# if ! defined DECAL_FEEDBACK 
    44          CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 
     46      CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 
     47! near boundary update: 
     48!      CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 
    4549# else 
    46          CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 
     50      CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 
     51! near boundary update: 
     52!      CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 
    4753# endif 
    48       ELSE 
    49 # if ! defined DECAL_FEEDBACK 
    50          CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 
    51 # else 
    52          CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 
    53 # endif 
    54       ENDIF 
    5554      ! 
    5655      Agrif_UseSpecialValueInUpdate = .FALSE. 
    5756      ! 
    58       IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 
    59          CALL Agrif_ChildGrid_To_ParentGrid() 
    60          CALL Agrif_Update_Tra() 
    61          CALL Agrif_ParentGrid_To_ChildGrid() 
    62       ENDIF 
    63       ! 
    6457#endif 
    6558      ! 
    6659   END SUBROUTINE Agrif_Update_Tra 
    6760 
    68  
    69    RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 
     61   SUBROUTINE Agrif_Update_Dyn( ) 
    7062      !!--------------------------------------------- 
    7163      !!   *** ROUTINE Agrif_Update_Dyn *** 
    … …  
    7567      ! 
    7668#if defined TWO_WAY 
    77       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline 
     69      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed() 
    7870 
    7971      Agrif_UseSpecialValueInUpdate = .FALSE. 
    8072      Agrif_SpecialValueFineGrid = 0. 
    8173      !      
    82       IF (mod(nbcline,nbclineupdate) == 0) THEN 
    8374# if ! defined DECAL_FEEDBACK 
    84          CALL Agrif_Update_Variable(un_update_id,procname = updateU) 
    85          CALL Agrif_Update_Variable(vn_update_id,procname = updateV) 
     75      CALL Agrif_Update_Variable(un_update_id,procname = updateU) 
     76      CALL Agrif_Update_Variable(vn_update_id,procname = updateV) 
     77! near boundary update: 
     78!      CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU) 
     79!      CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV) 
    8680# else 
    87          CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU) 
    88          CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV) 
     81      CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU) 
     82      CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV) 
     83! near boundary update: 
     84!      CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU) 
     85!      CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV) 
    8986# endif 
    90       ELSE 
    91 # if ! defined DECAL_FEEDBACK 
    92          CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU) 
    93          CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)          
    94 # else 
    95          CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU) 
    96          CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV) 
    97 # endif 
    98       ENDIF 
    9987 
    10088# if ! defined DECAL_FEEDBACK 
    … …  
    10593      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)   
    10694# endif 
    107  
     95      ! 
     96# if ! defined DECAL_FEEDBACK 
     97      ! Account for updated thicknesses at boundary edges 
     98      IF (.NOT.ln_linssh) THEN 
     99! For the time being calls below do not ensure reproducible results  
     100!         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_u_bdy) 
     101!         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_v_bdy) 
     102      ENDIF 
     103# endif 
     104      !  
    108105      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
    109106         ! Update time integrated transports 
    110          IF (mod(nbcline,nbclineupdate) == 0) THEN 
    111107#  if ! defined DECAL_FEEDBACK 
    112             CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 
    113             CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 
     108         CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 
     109         CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 
    114110#  else 
    115             CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b) 
    116             CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b) 
     111         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b) 
     112         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b) 
    117113#  endif 
    118          ELSE 
    119 #  if ! defined DECAL_FEEDBACK 
    120             CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b) 
    121             CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b) 
    122 #  else 
    123             CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b) 
    124             CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b) 
    125 #  endif 
    126          ENDIF 
    127114      END IF 
    128       ! 
    129       nbcline = nbcline + 1 
     115#endif 
     116      ! 
     117   END SUBROUTINE Agrif_Update_Dyn 
     118 
     119   SUBROUTINE Agrif_Update_ssh( ) 
     120      !!--------------------------------------------- 
     121      !!   *** ROUTINE Agrif_Update_ssh *** 
     122      !!--------------------------------------------- 
     123      !  
     124      IF (Agrif_Root()) RETURN 
     125      ! 
     126#if defined TWO_WAY 
    130127      ! 
    131128      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    136133      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH) 
    137134# endif 
     135      ! 
    138136      Agrif_UseSpecialValueInUpdate = .FALSE. 
    139       !  
     137      ! 
     138#  if defined DECAL_FEEDBACK && defined VOL_REFLUX 
     139      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
     140         ! Refluxing on ssh: 
     141         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0, 0/),locupdate2=(/1, 1/),procname = reflux_sshu) 
     142         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1, 1/),locupdate2=(/0, 0/),procname = reflux_sshv) 
     143      END IF 
     144#  endif 
     145      ! 
    140146#endif 
    141147      ! 
    142       ! Do recursive update: 
    143       IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 
    144          CALL Agrif_ChildGrid_To_ParentGrid() 
    145          CALL Agrif_Update_Dyn() 
    146          CALL Agrif_ParentGrid_To_ChildGrid() 
    147       ENDIF 
    148       ! 
    149    END SUBROUTINE Agrif_Update_Dyn 
     148   END SUBROUTINE Agrif_Update_ssh 
    150149 
    151150# if defined key_zdftke 
    … …  
    156155      !!--------------------------------------------- 
    157156      !! 
    158       INTEGER, INTENT(in) :: kt 
     157      INTEGER, INTENT(in) :: kt  
     158      !  
     159      IF (Agrif_Root()) RETURN 
    159160      !        
    160161      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 
    … …  
    176177# endif /* key_zdftke */ 
    177178 
     179   SUBROUTINE Agrif_Update_vvl( ) 
     180      !!--------------------------------------------- 
     181      !!   *** ROUTINE Agrif_Update_vvl *** 
     182      !!--------------------------------------------- 
     183      ! 
     184      IF (Agrif_Root()) RETURN 
     185      ! 
     186#if defined TWO_WAY   
     187      ! 
     188      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
     189      ! 
     190      Agrif_UseSpecialValueInUpdate = .TRUE. 
     191      Agrif_SpecialValueFineGrid = 0. 
     192      !  
     193      ! No interface separation here, update vertical grid at T points  
     194      ! everywhere over the overlapping regions (one account for refluxing in that case): 
     195      CALL Agrif_Update_Variable(e3t_id, procname=updatee3t)  
     196      ! 
     197      Agrif_UseSpecialValueInUpdate = .FALSE. 
     198      ! 
     199      CALL Agrif_ChildGrid_To_ParentGrid() 
     200      CALL dom_vvl_update_UVF 
     201      CALL Agrif_ParentGrid_To_ChildGrid() 
     202      ! 
     203#endif 
     204      ! 
     205   END SUBROUTINE Agrif_Update_vvl 
     206 
     207   SUBROUTINE dom_vvl_update_UVF 
     208      !!--------------------------------------------- 
     209      !!       *** ROUTINE dom_vvl_update_UVF *** 
     210      !!--------------------------------------------- 
     211      !! 
     212      INTEGER :: jk 
     213      REAL(wp):: zcoef 
     214      !!--------------------------------------------- 
     215 
     216      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', & 
     217                  & Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
     218 
     219      ! Save "old" scale factor (prior update) for subsequent asselin correction 
     220      ! of prognostic variables 
     221      ! ----------------------- 
     222      ! 
     223      e3u_a(:,:,:) = e3u_n(:,:,:) 
     224      e3v_a(:,:,:) = e3v_n(:,:,:) 
     225!      ua(:,:,:) = e3u_b(:,:,:) 
     226!      va(:,:,:) = e3v_b(:,:,:) 
     227      hu_a(:,:) = hu_n(:,:) 
     228      hv_a(:,:) = hv_n(:,:) 
     229 
     230      ! 1) NOW fields 
     231      !-------------- 
     232       
     233         ! Vertical scale factor interpolations 
     234         ! ------------------------------------ 
     235      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:) ,  'U' ) 
     236      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:) ,  'V' ) 
     237      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:) ,  'F' ) 
     238 
     239      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
     240      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     241 
     242         ! Update total depths: 
     243         ! -------------------- 
     244      hu_n(:,:) = 0._wp                        ! Ocean depth at U-points 
     245      hv_n(:,:) = 0._wp                        ! Ocean depth at V-points 
     246      DO jk = 1, jpkm1 
     247         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
     248         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
     249      END DO 
     250      !                                        ! Inverse of the local depth 
     251      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 
     252      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 
     253 
     254 
     255      ! 2) BEFORE fields: 
     256      !------------------ 
     257!      IF (     (.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_exp)) & 
     258!         & .OR.(.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_ts    & 
     259!         & .AND.(.NOT.ln_bt_fw)))) THEN 
     260      IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
     261         ! 
     262         ! Vertical scale factor interpolations 
     263         ! ------------------------------------ 
     264         CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:),  'U'  ) 
     265         CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:),  'V'  ) 
     266 
     267         CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
     268         CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
     269 
     270         ! Update total depths: 
     271         ! -------------------- 
     272         hu_b(:,:) = 0._wp                     ! Ocean depth at U-points 
     273         hv_b(:,:) = 0._wp                     ! Ocean depth at V-points 
     274         DO jk = 1, jpkm1 
     275            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
     276            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
     277         END DO 
     278         !                                     ! Inverse of the local depth 
     279         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
     280         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
     281      ENDIF 
     282      ! 
     283   END SUBROUTINE dom_vvl_update_UVF 
     284 
    178285   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    179286      !!--------------------------------------------- 
    … …  
    185292      !! 
    186293      INTEGER :: ji,jj,jk,jn 
     294      REAL(wp) :: ztb, ztnu, ztno 
    187295      !!--------------------------------------------- 
    188296      ! 
    … …  
    192300               DO jj=j1,j2 
    193301                  DO ji=i1,i2 
    194                      tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
     302!> jc tmp 
     303                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 
     304!                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) 
     305!< jc tmp 
    195306                  END DO 
    196307               END DO 
    … …  
    198309         END DO 
    199310      ELSE 
     311!> jc tmp 
     312         DO jn = n1,n2 
     313            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
     314                                         & * tmask(i1:i2,j1:j2,k1:k2) 
     315         ENDDO 
     316!< jc tmp 
    200317         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    201318            ! Add asselin part 
    … …  
    205322                     DO ji=i1,i2 
    206323                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
    207                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
    208                                  & + atfp * ( tabres(ji,jj,jk,jn) & 
    209                                  &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     324                           ztb  = tsb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 
     325                           ztnu = tabres(ji,jj,jk,jn) 
     326                           ztno = tsn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
     327                           tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
     328                                     &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
    210329                        ENDIF 
    211330                     ENDDO 
    … …  
    219338                  DO ji=i1,i2 
    220339                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
    221                         tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     340                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk) 
    222341                     END IF 
    223342                  END DO 
    … …  
    225344            END DO 
    226345         END DO 
     346         ! 
     347         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     348            tsb(i1:i2,j1:j2,k1:k2,n1:n2)  = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     349         ENDIF 
     350         ! 
    227351      ENDIF 
    228352      !  
    … …  
    238362      LOGICAL                               , INTENT(in   ) :: before 
    239363      ! 
    240       INTEGER  ::   ji, jj, jk 
    241       REAL(wp) ::   zrhoy 
     364      INTEGER  :: ji, jj, jk 
     365      REAL(wp) :: zrhoy, zub, zunu, zuno 
    242366      !!--------------------------------------------- 
    243367      !  
    … …  
    251375            DO jj=j1,j2 
    252376               DO ji=i1,i2 
    253                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 
     377                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj)  
    254378                  ! 
    255379                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    256                      ub(ji,jj,jk) = ub(ji,jj,jk) &  
    257                            & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     380                     zub  = ub(ji,jj,jk) * e3u_b(ji,jj,jk)  ! fse3t_b prior update should be used 
     381                     zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 
     382                     zunu = tabres(ji,jj,jk) 
     383                     ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &       
     384                                    & * umask(ji,jj,jk) / e3u_b(ji,jj,jk) 
    258385                  ENDIF 
    259386                  ! 
    260                   un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) 
    261                END DO 
    262             END DO 
    263          END DO 
     387                  un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) / e3u_n(ji,jj,jk) 
     388               END DO 
     389            END DO 
     390         END DO 
     391         ! 
     392         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     393            ub(i1:i2,j1:j2,k1:k2)  = un(i1:i2,j1:j2,k1:k2) 
     394         ENDIF 
     395         ! 
    264396      ENDIF 
    265397      !  
    266398   END SUBROUTINE updateu 
    267399 
    268  
    269    SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 
     400   SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     401      !!--------------------------------------------- 
     402      !!           *** ROUTINE correct_u_bdy *** 
     403      !!--------------------------------------------- 
     404      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
     405      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     406      LOGICAL                               , INTENT(in   ) :: before 
     407      INTEGER                               , INTENT(in)    :: nb, ndir 
     408      !! 
     409      LOGICAL :: western_side, eastern_side  
     410      ! 
     411      INTEGER  :: jj, jk 
     412      REAL(wp) :: zcor 
     413      !!--------------------------------------------- 
     414      !  
     415      IF( .NOT.before ) THEN 
     416         ! 
     417         western_side  = (nb == 1).AND.(ndir == 1) 
     418         eastern_side  = (nb == 1).AND.(ndir == 2) 
     419         ! 
     420         IF (western_side) THEN 
     421            DO jj=j1,j2 
     422               zcor = un_b(i1-1,jj) * hu_a(i1-1,jj) * r1_hu_n(i1-1,jj) - un_b(i1-1,jj) 
     423               un_b(i1-1,jj) = un_b(i1-1,jj) + zcor 
     424               DO jk=1,jpkm1 
     425                  un(i1-1,jj,jk) = un(i1-1,jj,jk) + zcor * umask(i1-1,jj,jk) 
     426               END DO  
     427            END DO 
     428         ENDIF 
     429         ! 
     430         IF (eastern_side) THEN 
     431            DO jj=j1,j2 
     432               zcor = un_b(i2+1,jj) * hu_a(i2+1,jj) * r1_hu_n(i2+1,jj) - un_b(i2+1,jj) 
     433               un_b(i2+1,jj) = un_b(i2+1,jj) + zcor 
     434               DO jk=1,jpkm1 
     435                  un(i2+1,jj,jk) = un(i2+1,jj,jk) + zcor * umask(i2+1,jj,jk) 
     436               END DO  
     437            END DO 
     438         ENDIF 
     439         ! 
     440      ENDIF 
     441      !  
     442   END SUBROUTINE correct_u_bdy 
     443 
     444 
     445   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before) 
    270446      !!--------------------------------------------- 
    271447      !!           *** ROUTINE updatev *** 
    272448      !!--------------------------------------------- 
    273       INTEGER :: i1,i2,j1,j2,k1,k2 
    274       INTEGER :: ji,jj,jk 
    275       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 
    276       LOGICAL :: before 
    277       !! 
    278       REAL(wp) :: zrhox 
     449      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
     450      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     451      LOGICAL                               , INTENT(in   ) :: before 
     452      ! 
     453      INTEGER  :: ji, jj, jk 
     454      REAL(wp) :: zrhox, zvb, zvnu, zvno 
    279455      !!---------------------------------------------       
    280456      ! 
    … …  
    292468            DO jj=j1,j2 
    293469               DO ji=i1,i2 
    294                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk) 
     470                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) 
    295471                  ! 
    296472                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    297                      vb(ji,jj,jk) = vb(ji,jj,jk) &  
    298                            & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     473                     zvb  = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 
     474                     zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 
     475                     zvnu = tabres(ji,jj,jk) 
     476                     vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &       
     477                                    & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk) 
    299478                  ENDIF 
    300479                  ! 
    301                   vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) 
    302                END DO 
    303             END DO 
    304          END DO 
     480                  vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) / e3v_n(ji,jj,jk) 
     481               END DO 
     482            END DO 
     483         END DO 
     484         ! 
     485         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     486            vb(i1:i2,j1:j2,k1:k2)  = vn(i1:i2,j1:j2,k1:k2) 
     487         ENDIF 
     488         ! 
    305489      ENDIF 
    306490      !  
    307491   END SUBROUTINE updatev 
     492 
     493   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     494      !!--------------------------------------------- 
     495      !!           *** ROUTINE correct_u_bdy *** 
     496      !!--------------------------------------------- 
     497      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
     498      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     499      LOGICAL                               , INTENT(in   ) :: before 
     500      INTEGER                               , INTENT(in)    :: nb, ndir 
     501      !! 
     502      LOGICAL :: southern_side, northern_side  
     503      ! 
     504      INTEGER  :: ji, jk 
     505      REAL(wp) :: zcor 
     506      !!--------------------------------------------- 
     507      !  
     508      IF( .NOT.before ) THEN 
     509         ! 
     510         southern_side = (nb == 2).AND.(ndir == 1) 
     511         northern_side = (nb == 2).AND.(ndir == 2) 
     512         ! 
     513         IF (southern_side) THEN 
     514            DO ji=i1,i2 
     515               zcor = vn_b(ji,j1-1) * hv_a(ji,j1-1) * r1_hv_n(ji,j1-1) - vn_b(ji,j1-1) 
     516               vn_b(ji,j1-1) = vn_b(ji,j1-1) + zcor 
     517               DO jk=1,jpkm1 
     518                  vn(ji,j1-1,jk) = vn(ji,j1-1,jk) + zcor * vmask(ji,j1-1,jk) 
     519               END DO  
     520            END DO 
     521         ENDIF 
     522         ! 
     523         IF (northern_side) THEN 
     524            DO ji=i1,i2 
     525               zcor = vn_b(ji,j2+1) * hv_a(ji,j2+1) * r1_hv_n(ji,j2+1) - vn_b(ji,j2+1) 
     526               vn_b(ji,j2+1) = vn_b(ji,j2+1) + zcor 
     527               DO jk=1,jpkm1 
     528                  vn(ji,j2+1,jk) = vn(ji,j2+1,jk) + zcor * vmask(ji,j2+1,jk) 
     529               END DO  
     530            END DO 
     531         ENDIF 
     532         ! 
     533      ENDIF 
     534      !  
     535   END SUBROUTINE correct_v_bdy 
    308536 
    309537 
    … …  
    316544      LOGICAL, INTENT(in) :: before 
    317545      !!  
    318       INTEGER :: ji, jj, jk 
     546      INTEGER  :: ji, jj, jk 
    319547      REAL(wp) :: zrhoy 
    320548      REAL(wp) :: zcorr 
    … …  
    331559         DO jj=j1,j2 
    332560            DO ji=i1,i2 
    333                tabres(ji,jj) =  tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj)   
     561               tabres(ji,jj) =  tabres(ji,jj) * r1_e2u(ji,jj)   
    334562               !     
    335563               ! Update "now" 3d velocities: 
    … …  
    338566                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    339567               END DO 
    340                spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj) 
    341568               ! 
    342                zcorr = tabres(ji,jj) - spgu(ji,jj) 
     569               zcorr = (tabres(ji,jj) - spgu(ji,jj)) * r1_hu_n(ji,jj) 
    343570               DO jk=1,jpkm1               
    344571                  un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)            
    … …  
    348575               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
    349576                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    350                      zcorr = tabres(ji,jj) - un_b(ji,jj) 
     577                     zcorr = (tabres(ji,jj) - un_b(ji,jj) * hu_a(ji,jj)) * r1_hu_b(ji,jj) 
    351578                     ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
    352579                  END IF 
    353                ENDIF              
    354                un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 
     580               ENDIF     
     581               un_b(ji,jj) = tabres(ji,jj) * r1_hu_n(ji,jj) * umask(ji,jj,1) 
    355582               !        
    356583               ! Correct "before" velocities to hold correct bt component: 
    … …  
    359586                  spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) 
    360587               END DO 
    361                spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj) 
    362588               ! 
    363                zcorr = ub_b(ji,jj) - spgu(ji,jj) 
     589               zcorr = ub_b(ji,jj) - spgu(ji,jj) * r1_hu_b(ji,jj) 
    364590               DO jk=1,jpkm1               
    365591                  ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)            
    … …  
    368594            END DO 
    369595         END DO 
     596         ! 
     597         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     598            ub_b(i1:i2,j1:j2)  = un_b(i1:i2,j1:j2) 
     599         ENDIF 
    370600      ENDIF 
    371601      ! 
    … …  
    381611      LOGICAL, INTENT(in) :: before 
    382612      !!  
    383       INTEGER :: ji, jj, jk 
     613      INTEGER  :: ji, jj, jk 
    384614      REAL(wp) :: zrhox 
    385615      REAL(wp) :: zcorr 
    … …  
    396626         DO jj=j1,j2 
    397627            DO ji=i1,i2 
    398                tabres(ji,jj) =  tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj)   
     628               tabres(ji,jj) =  tabres(ji,jj) * r1_e1v(ji,jj)   
    399629               !     
    400630               ! Update "now" 3d velocities: 
    … …  
    403633                  spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    404634               END DO 
    405                spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj) 
    406635               ! 
    407                zcorr = tabres(ji,jj) - spgv(ji,jj) 
     636               zcorr = (tabres(ji,jj) - spgv(ji,jj)) * r1_hv_n(ji,jj) 
    408637               DO jk=1,jpkm1               
    409638                  vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)            
    … …  
    413642               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
    414643                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    415                      zcorr = tabres(ji,jj) - vn_b(ji,jj) 
     644                     zcorr = (tabres(ji,jj) - vn_b(ji,jj) * hv_a(ji,jj)) * r1_hv_b(ji,jj) 
    416645                     vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
    417646                  END IF 
    418647               ENDIF               
    419                vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 
     648               vn_b(ji,jj) = tabres(ji,jj) * r1_hv_n(ji,jj) * vmask(ji,jj,1) 
    420649               !        
    421650               ! Correct "before" velocities to hold correct bt component: 
    … …  
    424653                  spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) 
    425654               END DO 
    426                spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj) 
    427655               ! 
    428                zcorr = vb_b(ji,jj) - spgv(ji,jj) 
     656               zcorr = vb_b(ji,jj) - spgv(ji,jj) * r1_hv_b(ji,jj) 
    429657               DO jk=1,jpkm1               
    430658                  vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)            
    … …  
    433661            END DO 
    434662         END DO 
     663         ! 
     664         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     665            vb_b(i1:i2,j1:j2)  = vn_b(i1:i2,j1:j2) 
     666         ENDIF 
     667         ! 
    435668      ENDIF 
    436669      !  
    … …  
    456689         END DO 
    457690      ELSE 
    458          IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 
    459             IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    460                DO jj=j1,j2 
    461                   DO ji=i1,i2 
    462                      sshb(ji,jj) =   sshb(ji,jj) & 
    463                            & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
    464                   END DO 
    465                END DO 
    466             ENDIF 
     691         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     692            DO jj=j1,j2 
     693               DO ji=i1,i2 
     694                  sshb(ji,jj) =   sshb(ji,jj) & 
     695                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     696               END DO 
     697            END DO 
    467698         ENDIF 
    468699         ! 
    … …  
    472703            END DO 
    473704         END DO 
     705         ! 
     706         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     707            sshb(i1:i2,j1:j2)  = sshn(i1:i2,j1:j2) 
     708         ENDIF 
     709         ! 
     710 
    474711      ENDIF 
    475712      ! 
    … …  
    486723      !! 
    487724      INTEGER :: ji, jj 
    488       REAL(wp) :: zrhoy 
     725      REAL(wp) :: zrhoy, za1, zcor 
    489726      !!--------------------------------------------- 
    490727      ! 
    … …  
    498735         tabres = zrhoy * tabres 
    499736      ELSE 
     737         !  
     738         tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e2u(i1:i2,j1:j2) 
     739         ! 
     740         za1 = 1._wp / REAL(Agrif_rhot(), wp) 
    500741         DO jj=j1,j2 
    501742            DO ji=i1,i2 
    502                ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj) 
     743               zcor=tabres(ji,jj) - ub2_b(ji,jj) 
     744               ! Update time integrated fluxes also in case of multiply nested grids: 
     745               ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * zcor  
     746               ! Update corrective fluxes: 
     747               un_bf(ji,jj)  = un_bf(ji,jj) + zcor 
     748               ! Update half step back fluxes: 
     749               ub2_b(ji,jj) = tabres(ji,jj) 
    503750            END DO 
    504751         END DO 
    … …  
    507754   END SUBROUTINE updateub2b 
    508755 
     756   SUBROUTINE reflux_sshu( tabres, i1, i2, j1, j2, before, nb, ndir ) 
     757      !!--------------------------------------------- 
     758      !!          *** ROUTINE reflux_sshu *** 
     759      !!--------------------------------------------- 
     760      INTEGER, INTENT(in) :: i1, i2, j1, j2 
     761      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     762      LOGICAL, INTENT(in) :: before 
     763      INTEGER, INTENT(in) :: nb, ndir 
     764      !! 
     765      LOGICAL :: western_side, eastern_side  
     766      INTEGER :: ji, jj 
     767      REAL(wp) :: zrhoy, za1, zcor 
     768      !!--------------------------------------------- 
     769      ! 
     770      IF (before) THEN 
     771         zrhoy = Agrif_Rhoy() 
     772         DO jj=j1,j2 
     773            DO ji=i1,i2 
     774               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj) 
     775            END DO 
     776         END DO 
     777         tabres = zrhoy * tabres 
     778      ELSE 
     779         !  
     780         tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e2u(i1:i2,j1:j2) 
     781         ! 
     782         western_side  = (nb == 1).AND.(ndir == 1) 
     783         eastern_side  = (nb == 1).AND.(ndir == 2) 
     784         ! 
     785         IF (western_side) THEN 
     786            DO jj=j1,j2 
     787               zcor = rdt * r1_e1e2t(i1  ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj))  
     788               sshn(i1  ,jj) = sshn(i1  ,jj) + zcor 
     789               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i1  ,jj) = sshb(i1  ,jj) + atfp * zcor 
     790            END DO 
     791         ENDIF 
     792         IF (eastern_side) THEN 
     793            DO jj=j1,j2 
     794               zcor = - rdt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj)) 
     795               sshn(i2+1,jj) = sshn(i2+1,jj) + zcor 
     796               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i2+1,jj) = sshb(i2+1,jj) + atfp * zcor 
     797            END DO 
     798         ENDIF 
     799         ! 
     800      ENDIF 
     801      ! 
     802   END SUBROUTINE reflux_sshu 
    509803 
    510804   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
    … …  
    517811      !! 
    518812      INTEGER :: ji, jj 
    519       REAL(wp) :: zrhox 
     813      REAL(wp) :: zrhox, za1, zcor 
    520814      !!--------------------------------------------- 
    521815      ! 
    … …  
    529823         tabres = zrhox * tabres 
    530824      ELSE 
     825         !  
     826         tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e1v(i1:i2,j1:j2) 
     827         ! 
     828         za1 = 1._wp / REAL(Agrif_rhot(), wp) 
    531829         DO jj=j1,j2 
    532830            DO ji=i1,i2 
    533                vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj) 
     831               zcor=tabres(ji,jj) - vb2_b(ji,jj) 
     832               ! Update time integrated fluxes also in case of multiply nested grids: 
     833               vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * zcor  
     834               ! Update corrective fluxes: 
     835               vn_bf(ji,jj)  = vn_bf(ji,jj) + zcor 
     836               ! Update half step back fluxes: 
     837               vb2_b(ji,jj) = tabres(ji,jj) 
    534838            END DO 
    535839         END DO 
    … …  
    538842   END SUBROUTINE updatevb2b 
    539843 
     844   SUBROUTINE reflux_sshv( tabres, i1, i2, j1, j2, before, nb, ndir ) 
     845      !!--------------------------------------------- 
     846      !!          *** ROUTINE reflux_sshv *** 
     847      !!--------------------------------------------- 
     848      INTEGER, INTENT(in) :: i1, i2, j1, j2 
     849      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     850      LOGICAL, INTENT(in) :: before 
     851      INTEGER, INTENT(in) :: nb, ndir 
     852      !! 
     853      LOGICAL :: southern_side, northern_side  
     854      INTEGER :: ji, jj 
     855      REAL(wp) :: zrhox, za1, zcor 
     856      !!--------------------------------------------- 
     857      ! 
     858      IF (before) THEN 
     859         zrhox = Agrif_Rhox() 
     860         DO jj=j1,j2 
     861            DO ji=i1,i2 
     862               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj)  
     863            END DO 
     864         END DO 
     865         tabres = zrhox * tabres 
     866      ELSE 
     867         !  
     868         tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e1v(i1:i2,j1:j2) 
     869         ! 
     870         southern_side = (nb == 2).AND.(ndir == 1) 
     871         northern_side = (nb == 2).AND.(ndir == 2) 
     872         ! 
     873         IF (southern_side) THEN 
     874            DO ji=i1,i2 
     875               zcor = rdt * r1_e1e2t(ji,j1  ) * e1v(ji,j1  ) * (vb2_b(ji,j1)-tabres(ji,j1)) 
     876               sshn(ji,j1  ) = sshn(ji,j1  ) + zcor 
     877               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j1  ) = sshb(ji,j1) + atfp * zcor 
     878            END DO 
     879         ENDIF 
     880         IF (northern_side) THEN                
     881            DO ji=i1,i2 
     882               zcor = - rdt * r1_e1e2t(ji,j2+1) * e1v(ji,j2  ) * (vb2_b(ji,j2)-tabres(ji,j2)) 
     883               sshn(ji,j2+1) = sshn(ji,j2+1) + zcor 
     884               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j2+1) = sshb(ji,j2+1) + atfp * zcor 
     885            END DO 
     886         ENDIF 
     887         !  
     888      ENDIF 
     889      ! 
     890   END SUBROUTINE reflux_sshv 
    540891 
    541892   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 
    … …  
    644995# endif /* key_zdftke */  
    645996 
     997   SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 
     998      !!--------------------------------------------- 
     999      !!           *** ROUTINE updatee3t *** 
     1000      !!--------------------------------------------- 
     1001      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab_dum 
     1002      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     1003      LOGICAL, INTENT(in) :: before 
     1004      ! 
     1005      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptab 
     1006      INTEGER :: ji,jj,jk 
     1007      REAL(wp) :: zcoef 
     1008      !!--------------------------------------------- 
     1009      ! 
     1010      IF (.NOT.before) THEN 
     1011         ! 
     1012         ALLOCATE(ptab(i1:i2,j1:j2,1:jpk))  
     1013         ! 
     1014         ! Update e3t from ssh (z* case only) 
     1015         DO jk = 1, jpkm1 
     1016            DO jj=j1,j2 
     1017               DO ji=i1,i2 
     1018                  ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + sshn(ji,jj) & 
     1019                                     & *ssmask(ji,jj)/(ht_0(ji,jj)-1._wp + ssmask(ji,jj))) 
     1020               END DO 
     1021            END DO 
     1022         END DO 
     1023         ! 
     1024         ! 1) Updates at BEFORE time step: 
     1025         ! ------------------------------- 
     1026         ! 
     1027         ! Save "old" scale factor (prior update) for subsequent asselin correction 
     1028         ! of prognostic variables 
     1029         e3t_a(i1:i2,j1:j2,1:jpkm1) = e3t_n(i1:i2,j1:j2,1:jpkm1) 
     1030 
     1031         ! One should also save e3t_b, but lacking of workspace... 
     1032!         hdivn(i1:i2,j1:j2,1:jpkm1)   = e3t_b(i1:i2,j1:j2,1:jpkm1) 
     1033 
     1034         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
     1035            DO jk = 1, jpkm1 
     1036               DO jj=j1,j2 
     1037                  DO ji=i1,i2 
     1038                     e3t_b(ji,jj,jk) =  e3t_b(ji,jj,jk) & 
     1039                           & + atfp * ( ptab(ji,jj,jk) - e3t_n(ji,jj,jk) ) 
     1040                  END DO 
     1041               END DO 
     1042            END DO 
     1043            ! 
     1044            e3w_b  (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + e3t_b(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1) 
     1045            gdepw_b(i1:i2,j1:j2,1) = 0.0_wp 
     1046            gdept_b(i1:i2,j1:j2,1) = 0.5_wp * e3w_b(i1:i2,j1:j2,1) 
     1047            ! 
     1048            DO jk = 2, jpk 
     1049               DO jj = j1,j2 
     1050                  DO ji = i1,i2             
     1051                     zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     1052                     e3w_b(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        &  
     1053                     &                                        ( e3t_b(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )  & 
     1054                     &                                  +            0.5_wp * tmask(ji,jj,jk)   *        & 
     1055                     &                                        ( e3t_b(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) ) 
     1056                     gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1) 
     1057                     gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  & 
     1058                         &               + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk))  
     1059                  END DO 
     1060               END DO 
     1061            END DO 
     1062            ! 
     1063         ENDIF         
     1064         ! 
     1065         ! 2) Updates at NOW time step: 
     1066         ! ---------------------------- 
     1067         ! 
     1068         ! Update vertical scale factor at T-points: 
     1069         e3t_n(i1:i2,j1:j2,1:jpkm1) = ptab(i1:i2,j1:j2,1:jpkm1) 
     1070         ! 
     1071         ! Update total depth: 
     1072         ht_n(i1:i2,j1:j2) = 0._wp 
     1073         DO jk = 1, jpkm1 
     1074            ht_n(i1:i2,j1:j2) = ht_n(i1:i2,j1:j2) + e3t_n(i1:i2,j1:j2,jk) * tmask(i1:i2,j1:j2,jk) 
     1075         END DO 
     1076         ! 
     1077         ! Update vertical scale factor at W-points and depths: 
     1078         e3w_n (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + e3t_n(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1) 
     1079         gdept_n(i1:i2,j1:j2,1) = 0.5_wp * e3w_n(i1:i2,j1:j2,1) 
     1080         gdepw_n(i1:i2,j1:j2,1) = 0.0_wp 
     1081         gde3w_n(i1:i2,j1:j2,1) = gdept_n(i1:i2,j1:j2,1) - (ht_n(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh 
     1082         ! 
     1083         DO jk = 2, jpk 
     1084            DO jj = j1,j2 
     1085               DO ji = i1,i2             
     1086               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     1087               e3w_n(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t_n(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )   & 
     1088               &                                  +            0.5_wp * tmask(ji,jj,jk)   * ( e3t_n(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) ) 
     1089               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
     1090               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
     1091                   &               + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk))  
     1092               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - (ht_n(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh 
     1093               END DO 
     1094            END DO 
     1095         END DO 
     1096         ! 
     1097         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     1098            e3t_b (i1:i2,j1:j2,1:jpk)  = e3t_n (i1:i2,j1:j2,1:jpk) 
     1099            e3w_b (i1:i2,j1:j2,1:jpk)  = e3w_n (i1:i2,j1:j2,1:jpk) 
     1100            gdepw_b(i1:i2,j1:j2,1:jpk) = gdepw_n(i1:i2,j1:j2,1:jpk) 
     1101            gdept_b(i1:i2,j1:j2,1:jpk) = gdept_n(i1:i2,j1:j2,1:jpk) 
     1102         ENDIF 
     1103         ! 
     1104         DEALLOCATE(ptab) 
     1105      ENDIF 
     1106      ! 
     1107   END SUBROUTINE updatee3t 
     1108 
    6461109#else 
    6471110CONTAINS 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r6140 r8973  
    4646      ! 
    4747#if defined SPONGE_TOP 
    48       timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 
     48!!      timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 
     49!! Assume persistence  
     50      timecoeff = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 
    4951      CALL Agrif_sponge 
    5052      Agrif_SpecialValue    = 0._wp 
    … …  
    7375      ! 
    7476      IF( before ) THEN 
    75          tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     77         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trb(i1:i2,j1:j2,k1:k2,n1:n2) 
    7678      ELSE       
    7779!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r6140 r8973  
    2424   PUBLIC Agrif_Update_Trc 
    2525 
    26    INTEGER, PUBLIC ::   nbcline_trc = 0   !: ??? 
    27  
    2826   !!---------------------------------------------------------------------- 
    2927   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    … …  
    3331CONTAINS 
    3432 
    35    SUBROUTINE Agrif_Update_Trc( kt ) 
     33   SUBROUTINE Agrif_Update_Trc( ) 
    3634      !!---------------------------------------------------------------------- 
    3735      !!                   *** ROUTINE Agrif_Update_Trc *** 
    3836      !!---------------------------------------------------------------------- 
    39       INTEGER, INTENT(in) ::   kt 
    40       !!---------------------------------------------------------------------- 
    4137      !  
    42       IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
     38      IF (Agrif_Root()) RETURN  
     39      ! 
    4340#if defined TWO_WAY    
    4441      Agrif_UseSpecialValueInUpdate = .TRUE. 
    4542      Agrif_SpecialValueFineGrid    = 0._wp 
    4643      !  
    47       IF( MOD(nbcline_trc,nbclineupdate) == 0 ) THEN 
    4844# if ! defined DECAL_FEEDBACK 
    49          CALL Agrif_Update_Variable(trn_id, procname=updateTRC ) 
     45      CALL Agrif_Update_Variable(trn_id, procname=updateTRC ) 
     46!      CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC ) 
    5047# else 
    51          CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC ) 
     48      CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC ) 
     49!      CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC ) 
    5250# endif 
    53       ELSE 
    54 # if ! defined DECAL_FEEDBACK 
    55          CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC ) 
    56 # else 
    57          CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC ) 
    58 # endif 
    59       ENDIF 
    6051      ! 
    6152      Agrif_UseSpecialValueInUpdate = .FALSE. 
    62       nbcline_trc = nbcline_trc + 1 
     53      ! 
    6354#endif 
    6455      ! 
    … …  
    6657 
    6758 
    68    SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     59   SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    6960      !!---------------------------------------------------------------------- 
    70       !!                      *** ROUTINE updateT *** 
     61      !!                      *** ROUTINE updateTRC *** 
    7162      !!---------------------------------------------------------------------- 
    7263      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
    73       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
     64      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
    7465      LOGICAL                                    , INTENT(in   ) ::   before 
    7566      !! 
    76       INTEGER ::   ji, jj, jk, jn 
     67      INTEGER :: ji,jj,jk,jn 
     68      REAL(wp) :: ztb, ztnu, ztno 
    7769      !!---------------------------------------------------------------------- 
    7870      ! 
    79       IF( before ) THEN 
    80          ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    81       ELSE 
    82          IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN 
    83             ! Add asselin part 
    84             DO jn = n1,n2 
    85                DO jk = k1, k2 
    86                   DO jj = j1, j2 
    87                      DO ji = i1, i2 
    88                         IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 
    89                            trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn)             &  
    90                               &             + atfp * ( ptab(ji,jj,jk,jn)   & 
    91                                  &                    - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    92                         ENDIF 
    93                      END DO 
     71      ! 
     72      IF (before) THEN 
     73         DO jn = n1,n2 
     74            DO jk=k1,k2 
     75               DO jj=j1,j2 
     76                  DO ji=i1,i2 
     77!> jc tmp 
     78                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 
     79!                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) 
     80!< jc tmp 
    9481                  END DO 
    9582               END DO 
    9683            END DO 
     84         END DO 
     85      ELSE 
     86!> jc tmp 
     87         DO jn = n1,n2 
     88            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
     89                                         & * tmask(i1:i2,j1:j2,k1:k2) 
     90         ENDDO 
     91!< jc tmp 
     92         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     93            ! Add asselin part 
     94            DO jn = n1,n2 
     95               DO jk=k1,k2 
     96                  DO jj=j1,j2 
     97                     DO ji=i1,i2 
     98                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
     99                           ztb  = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 
     100                           ztnu = tabres(ji,jj,jk,jn) 
     101                           ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
     102                           trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
     103                                     &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
     104                        ENDIF 
     105                     ENDDO 
     106                  ENDDO 
     107               ENDDO 
     108            ENDDO 
    97109         ENDIF 
    98          DO jn = n1, n2 
    99             DO jk = k1, k2 
    100                DO jj = j1, j2 
    101                   DO ji = i1, i2 
    102                      IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN  
    103                         trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     110         DO jn = n1,n2 
     111            DO jk=k1,k2 
     112               DO jj=j1,j2 
     113                  DO ji=i1,i2 
     114                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
     115                        trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk) 
    104116                     END IF 
    105117                  END DO 
    … …  
    107119            END DO 
    108120         END DO 
     121         ! 
     122         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     123            trb(i1:i2,j1:j2,k1:k2,n1:n2)  = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     124         ENDIF 
     125         ! 
    109126      ENDIF 
    110127      !  

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r7761 r8973  
     1#undef UPD_HIGH   /* MIX HIGH UPDATE */ 
    12#if defined key_agrif 
    23!!---------------------------------------------------------------------- 
    … …  
    8889# endif 
    8990   ! 
     91   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) CALL agrif_Update_ini() 
     92 
     93   Agrif_UseSpecialValueInUpdate = .FALSE.      
     94 
    9095END SUBROUTINE Agrif_initvalues 
    9196 
    … …  
    144149   CALL Agrif_Set_bc(e2v_id,(/0,0/)) 
    145150 
    146    ! 5. Update type 
     151   ! 4. Update type 
    147152   !---------------  
     153# if defined UPD_HIGH 
     154   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
     155   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
     156#else 
    148157   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    149158   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    150  
    151 ! High order updates 
    152 !   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting) 
    153 !   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average) 
    154     ! 
     159#endif 
     160 
    155161END SUBROUTINE agrif_declare_var_dom 
    156162 
    … …  
    175181   ! 
    176182   LOGICAL :: check_namelist 
    177    CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 
     183   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    178184   !!---------------------------------------------------------------------- 
    179185 
    … …  
    205211   Agrif_UseSpecialValue = .TRUE. 
    206212   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
     213   hbdy_w(:) = 0.e0 ; hbdy_e(:) = 0.e0 ; hbdy_n(:) = 0.e0 ; hbdy_s(:) = 0.e0 
     214   ssha(:,:) = 0.e0 
    207215 
    208216   IF ( ln_dynspg_ts ) THEN 
    … …  
    212220      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    213221      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    214       ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
    215       ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
    216       ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
    217       ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
     222      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 
     223      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 
     224      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 
     225      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 
    218226   ENDIF 
    219227 
    … …  
    234242         WRITE(cl_check2,*)  NINT(rdt) 
    235243         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
    236          CALL ctl_stop( 'incompatible time step between ocean grids',   & 
     244         CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    237245               &               'parent grid value : '//cl_check1    ,   &  
    238246               &               'child  grid value : '//cl_check2    ,   &  
    … …  
    245253         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    246254         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    247          CALL ctl_warn( 'incompatible run length between grids'               ,   & 
    248                &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
    249                &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     255         CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
     256               &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
     257               &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    250258         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    251259         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    252260      ENDIF 
    253261 
    254       ! Check coordinates 
    255      !SF  IF( ln_zps ) THEN 
    256      !SF     ! check parameters for partial steps  
    257      !SF     IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    258      !SF        WRITE(*,*) 'incompatible e3zps_min between grids' 
    259      !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    260      !SF        WRITE(*,*) 'child grid  :',e3zps_min 
    261      !SF        WRITE(*,*) 'those values should be identical' 
    262      !SF        STOP 
    263      !SF     ENDIF 
    264      !SF     IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    265      !SF        WRITE(*,*) 'incompatible e3zps_rat between grids' 
    266      !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    267      !SF        WRITE(*,*) 'child grid  :',e3zps_rat 
    268      !SF        WRITE(*,*) 'those values should be identical'                   
    269      !SF        STOP 
    270      !SF     ENDIF 
    271      !SF  ENDIF 
    272  
    273262      ! Check free surface scheme 
    274263      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
    275264         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
    276          WRITE(*,*) 'incompatible free surface scheme between grids' 
    277          WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts ) 
    278          WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 
    279          WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts 
    280          WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp 
    281          WRITE(*,*) 'those logicals should be identical'                   
     265         WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts ) 
     266         WRITE(cl_check2,*)  ln_dynspg_ts 
     267         WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp ) 
     268         WRITE(cl_check4,*)  ln_dynspg_exp 
     269         CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  & 
     270               &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  &  
     271               &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  & 
     272               &               'parent grid ln_dynspg_exp :'//cl_check3  ,  & 
     273               &               'child  grid ln_dynspg_exp :'//cl_check4  ,  & 
     274               &               'those logicals should be identical' )                  
     275         STOP 
     276      ENDIF 
     277 
     278      ! Check if identical linear free surface option 
     279      IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 
     280         & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 
     281         WRITE(cl_check1,*)  Agrif_Parent(ln_linssh ) 
     282         WRITE(cl_check2,*)  ln_linssh 
     283         CALL ctl_stop( 'Incompatible linearized fs option between grids',  & 
     284               &               'parent grid ln_linssh  :'//cl_check1     ,  & 
     285               &               'child  grid ln_linssh  :'//cl_check2     ,  & 
     286               &               'those logicals should be identical' )                   
    282287         STOP 
    283288      ENDIF 
    … …  
    306311   ENDIF 
    307312   !  
    308    ! Do update at initialisation because not done before writing restarts 
    309    ! This would indeed change boundary conditions values at initial time 
    310    ! hence produce restartability issues. 
    311    ! Note that update below is recursive (with lk_agrif_doupd=T): 
    312    !  
    313 ! JC: I am not sure if Agrif_MaxLevel() is the "relative" 
    314 !     or the absolute maximum nesting level...TBC                         
    315    IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN  
    316       ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 
    317       CALL Agrif_Update_tra() 
    318       CALL Agrif_Update_dyn() 
    319    ENDIF 
    320    ! 
     313END SUBROUTINE Agrif_InitValues_cont 
     314 
     315RECURSIVE SUBROUTINE Agrif_Update_ini( ) 
     316   !!---------------------------------------------------------------------- 
     317   !!                 *** ROUTINE agrif_Update_ini *** 
     318   !! 
     319   !! ** Purpose :: Recursive update done at initialization 
     320   !!---------------------------------------------------------------------- 
     321   USE dom_oce 
     322   USE agrif_opa_update 
     323#if defined key_top 
     324   USE agrif_top_update 
     325#endif 
     326   ! 
     327   IMPLICIT NONE 
     328   !!---------------------------------------------------------------------- 
     329   ! 
     330   IF (Agrif_Root()) RETURN 
     331   ! 
     332                       CALL Agrif_Update_ssh() 
     333   IF (.NOT.ln_linssh) CALL Agrif_Update_vvl() 
     334                       CALL Agrif_Update_tra() 
     335#if defined key_top 
     336                       CALL Agrif_Update_Trc() 
     337#endif 
     338                       CALL Agrif_Update_dyn() 
    321339# if defined key_zdftke 
    322    CALL Agrif_Update_tke(0) 
    323 # endif 
    324    ! 
    325    Agrif_UseSpecialValueInUpdate = .FALSE. 
    326    nbcline = 0 
    327    lk_agrif_doupd = .FALSE. 
    328    ! 
    329 END SUBROUTINE Agrif_InitValues_cont 
    330  
     340! JC remove update because this precludes from perfect restartability 
     341!!                       CALL Agrif_Update_tke(0) 
     342# endif 
     343 
     344   CALL Agrif_ChildGrid_To_ParentGrid() 
     345   CALL Agrif_Update_ini() 
     346   CALL Agrif_ParentGrid_To_ChildGrid() 
     347 
     348END SUBROUTINE agrif_update_ini 
    331349 
    332350SUBROUTINE agrif_declare_var 
    … …  
    371389   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    372390 
    373 # if defined key_zdftke 
    374    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    375    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    376    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     391# if defined key_zdftke || defined key_zdfgls 
     392   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
     393   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     394   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avm_id) 
    377395# endif 
    378396 
    … …  
    400418   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
    401419 
    402 # if defined key_zdftke 
     420# if defined key_zdftke || defined key_zdfgls 
    403421   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 
    404422# endif 
    … …  
    411429   CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 
    412430 
    413 !   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 
    414 !   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
    415 !   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
    416431   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    417432   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    … …  
    428443   CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 
    429444 
     445# if defined key_zdftke || defined key_zdfgls 
     446   CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
     447# endif 
     448 
     449   ! 4. Update type 
     450   !---------------  
     451   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     452 
     453# if defined UPD_HIGH 
     454   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     455   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     456   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     457 
     458   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     459   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     460   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
     461   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
     462 
    430463# if defined key_zdftke 
    431    CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
    432 # endif 
    433  
    434    ! 5. Update type 
    435    !---------------  
     464   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
     465   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
     466   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
     467# endif 
     468 
     469#else 
    436470   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    437  
    438    CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    439  
    440471   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    441472   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    442473 
    443    CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    444  
    445474   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    446475   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     476   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     477   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    447478 
    448479# if defined key_zdftke 
    … …  
    452483# endif 
    453484 
    454 ! High order updates 
    455 !   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    456 !   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    457 !   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    458 ! 
    459 !   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    460 !   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    461 !   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
    462  
     485#endif 
    463486   ! 
    464487END SUBROUTINE agrif_declare_var 
    … …  
    594617      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 
    595618   ENDIF 
    596  
    597    ! stop if update frequency is different from nn_fsbc 
    598    IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc') 
    599  
    600  
    601619   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1) 
    602620   !---------------------------------------------------------------------- 
    … …  
    733751      ENDIF 
    734752 
    735       ! Check coordinates 
    736       IF( ln_zps ) THEN 
    737          ! check parameters for partial steps  
    738          IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    739             WRITE(*,*) 'incompatible e3zps_min between grids' 
    740             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    741             WRITE(*,*) 'child grid  :',e3zps_min 
    742             WRITE(*,*) 'those values should be identical' 
    743             STOP 
    744          ENDIF 
    745          IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN 
    746             WRITE(*,*) 'incompatible e3zps_rat between grids' 
    747             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    748             WRITE(*,*) 'child grid  :',e3zps_rat 
    749             WRITE(*,*) 'those values should be identical'                   
    750             STOP 
    751          ENDIF 
    752753      ENDIF 
    753754      ! Check passive tracer cell 
    … …  
    756757      ENDIF 
    757758   ENDIF 
    758  
    759    CALL Agrif_Update_trc(0) 
    760    ! 
    761    Agrif_UseSpecialValueInUpdate = .FALSE. 
    762    nbcline_trc = 0 
    763759   ! 
    764760END SUBROUTINE Agrif_InitValues_cont_top 
    … …  
    792788   !----------------------------- 
    793789   CALL Agrif_Set_bc(trn_id,(/0,1/)) 
    794 !   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 
    795790   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    796791 
    797    ! 5. Update type 
     792   ! 4. Update type 
    798793   !---------------  
     794# if defined UPD_HIGH 
     795   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 
     796#else 
    799797   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    800  
    801 !   Higher order update 
    802 !   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    803  
     798#endif 
    804799   ! 
    805800END SUBROUTINE agrif_declare_var_top 
    … …  
    832827   INTEGER  ::   ios                 ! Local integer output status for namelist read 
    833828   INTEGER  ::   iminspon 
    834    NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
     829   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
    835830   !!-------------------------------------------------------------------------------------- 
    836831   ! 
    … …  
    849844      WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    850845      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    851       WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update 
    852846      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
    853847      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    … …  
    858852   ! 
    859853   ! convert DOCTOR namelist name into OLD names 
    860    nbclineupdate = nn_cln_update 
    861854   visc_tra      = rn_sponge_tra 
    862855   visc_dyn      = rn_sponge_dyn 
    … …  
    878871SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    879872   !!---------------------------------------------------------------------- 
    880    !!                     *** ROUTINE Agrif_detect *** 
     873   !!                     *** ROUTINE Agrif_InvLoc *** 
    881874   !!---------------------------------------------------------------------- 
    882875   USE dom_oce 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r7914 r8973  
    5353   INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt) 
    5454   REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T) 
     55   REAL(wp), PUBLIC :: rn_bt_alpha      !: Time stepping diffusion parameter 
    5556 
    5657 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r7753 r8973  
    276276               ENDIF 
    277277            END DO 
     278#if defined key_agrif  
     279       IF( .NOT. AGRIF_Root() ) THEN  
     280          IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east  
     281          IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west  
     282          IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north  
     283          IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south  
     284       ENDIF  
     285#endif  
    278286         END DO 
    279287         ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7753 r8973  
    10291029      ! 
    10301030#if defined key_agrif 
    1031       IF(.NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented with non-linear free surface' ) 
     1031      IF( (.NOT.Agrif_Root()).AND.(.NOT.ln_vvl_zstar) )CALL ctl_stop( 'AGRIF is implemented with zstar coordinate only' ) 
    10321032#endif 
    10331033      ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r7753 r8973  
    132132            ! so that asselin contribution is removed at the same time  
    133133            DO jk = 1, jpkm1 
    134                un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
    135                vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
     134               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) )*umask(:,:,jk) 
     135               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
    136136            END DO   
    137137         ENDIF 
    … …  
    209209            ! (used as a now filtered scale factor until the swap) 
    210210            ! ---------------------------------------------------- 
    211             IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting 
    212                e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 
    213             ELSE 
    214                DO jk = 1, jpkm1 
    215                   e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     211            DO jk = 1, jpkm1 
     212               e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     213            END DO 
     214            ! Add volume filter correction: compatibility with tracer advection scheme 
     215            ! => time filter + conservation correction (only at the first level) 
     216            zcoef = atfp * rdt * r1_rau0 
     217            IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting 
     218               e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 
     219                              &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
     220            ELSE                     ! if ice shelf melting 
     221               DO jj = 1, jpj 
     222                  DO ji = 1, jpi 
     223                     ikt = mikt(ji,jj) 
     224                     e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  & 
     225                        &                                           - rnf_b   (ji,jj) + rnf   (ji,jj)  & 
     226                        &                                           + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,ikt) 
     227                  END DO 
    216228               END DO 
    217                ! Add volume filter correction: compatibility with tracer advection scheme 
    218                ! => time filter + conservation correction (only at the first level) 
    219                zcoef = atfp * rdt * r1_rau0 
    220                IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting 
    221                   e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 
    222                                  &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
    223                ELSE                     ! if ice shelf melting 
    224                   DO jj = 1, jpj 
    225                      DO ji = 1, jpi 
    226                         ikt = mikt(ji,jj) 
    227                         e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  & 
    228                            &                                           - rnf_b   (ji,jj) + rnf   (ji,jj)  & 
    229                            &                                           + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,ikt) 
    230                      END DO 
    231                   END DO 
    232                END IF 
    233             ENDIF 
     229            END IF 
    234230            ! 
    235231            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r7753 r8973  
    7474      ! 
    7575      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    76       REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar 
     76      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r, zld        ! temporary scalar 
    7777      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    7878      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
    … …  
    121121               END DO  
    122122            END DO 
     123            ! 
     124            IF (ln_scal_load) THEN 
     125               zld = rn_scal_load * grav 
     126               DO jj = 2, jpjm1                    ! add scalar approximation for load potential 
     127                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     128                     spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
     129                     spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
     130                  END DO  
     131               END DO 
     132            ENDIF 
    123133         ENDIF 
    124134         ! 
    … …  
    183193      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   & 
    184194      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   & 
    185       &                    nn_baro , rn_bt_cmax, nn_bt_flt 
     195      &                    nn_baro , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 
    186196      !!---------------------------------------------------------------------- 
    187197      ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r7831 r8973  
    5252#if defined key_agrif 
    5353   USE agrif_opa_interp ! agrif 
     54   USE agrif_oce 
    5455#endif 
    5556#if defined key_asminc    
    … …  
    6667   PUBLIC ts_rst            !    "      "     "    " 
    6768 
    68    INTEGER, SAVE :: icycle  ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 
    69    REAL(wp),SAVE :: rdtbt   ! Barotropic time step 
     69   INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 
     70   REAL(wp),SAVE :: rdtbt       ! Barotropic time step 
    7071 
    7172   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields 
    … …  
    7677 
    7778   !! Time filtered arrays at baroclinic time step: 
    78    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection vel. at "now" barocl. step 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection fluxes at "now" barocl. step 
    7980 
    8081   !! * Substitutions 
    … …  
    127128      !!      -Update the filtered free surface at step "n+1"      : ssha 
    128129      !!      -Update filtered barotropic velocities at step "n+1" : ua_b, va_b 
    129       !!      -Compute barotropic advective velocities at step "n" : un_adv, vn_adv 
     130      !!      -Compute barotropic advective fluxes at step "n"    : un_adv, vn_adv 
    130131      !!      These are used to advect tracers and are compliant with discrete 
    131132      !!      continuity equation taken at the baroclinic time steps. This  
    … …  
    150151      REAL(wp) ::   zhura, zhvra          !   -      - 
    151152      REAL(wp) ::   za0, za1, za2, za3    !   -      - 
    152       ! 
     153      REAL(wp) ::   zepsilon, zgamma            !   -      - 
    153154      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 
    154155      REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 
    … …  
    758759           za3= 0._wp               
    759760         ELSE                               ! AB3-AM4 Coefficients; bet=0.281105 ; eps=0.013 ; gam=0.0880  
    760            za0=0.614_wp                     ! za0 = 1/2 +   gam + 2*eps     
    761            za1=0.285_wp                     ! za1 = 1/2 - 2*gam - 3*eps  
    762            za2=0.088_wp                     ! za2 = gam 
    763            za3=0.013_wp                     ! za3 = eps 
     761            IF (rn_bt_alpha==0._wp) THEN 
     762               za0=0.614_wp                 ! za0 = 1/2 +   gam + 2*eps 
     763               za1=0.285_wp                 ! za1 = 1/2 - 2*gam - 3*eps 
     764               za2=0.088_wp                 ! za2 = gam 
     765               za3=0.013_wp                 ! za3 = eps 
     766            ELSE 
     767               zepsilon = 0.00976186_wp - 0.13451357_wp * rn_bt_alpha 
     768               zgamma = 0.08344500_wp - 0.51358400_wp * rn_bt_alpha 
     769               za0 = 0.5_wp + zgamma + 2._wp * rn_bt_alpha + 2._wp * zepsilon 
     770               za1 = 1._wp - za0 - zgamma - zepsilon 
     771               za2 = zgamma 
     772               za3 = zepsilon 
     773            ENDIF  
    764774         ENDIF 
    765775         ! 
    … …  
    901911                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    902912                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    903                  zwx(ji,jj) = zu_spg * zcpx(ji,jj)  
    904                  zwy(ji,jj) = zv_spg * zcpy(ji,jj) 
     913                 zwx(ji,jj) = (1._wp - rn_scal_load) * zu_spg * zcpx(ji,jj)  
     914                 zwy(ji,jj) = (1._wp - rn_scal_load) * zv_spg * zcpy(ji,jj) 
    905915              END DO 
    906916           END DO 
    … …  
    911921                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    912922                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    913                  zwx(ji,jj) = zu_spg 
    914                  zwy(ji,jj) = zv_spg 
     923                 zwx(ji,jj) = (1._wp - rn_scal_load) * zu_spg 
     924                 zwy(ji,jj) = (1._wp - rn_scal_load) * zv_spg 
    915925              END DO 
    916926           END DO 
    … …  
    10191029      ! 
    10201030      ! Set advection velocity correction: 
    1021       zwx(:,:) = un_adv(:,:) 
    1022       zwy(:,:) = vn_adv(:,:) 
    1023       IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
    1024          un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 
    1025          vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 
    1026       ELSE 
    1027          un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 
    1028          vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 
    1029       END IF 
    1030  
    1031       IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
     1031      IF (ln_bt_fw) THEN 
     1032         zwx(:,:) = un_adv(:,:) 
     1033         zwy(:,:) = vn_adv(:,:) 
     1034         IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 
     1035            un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) ) 
     1036            vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) ) 
     1037            ! 
     1038            ! Update corrective fluxes for next time step: 
     1039            un_bf(:,:)  = atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:)) 
     1040            vn_bf(:,:)  = atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:)) 
     1041         ELSE 
     1042            un_bf(:,:) = 0._wp 
     1043            vn_bf(:,:) = 0._wp  
     1044         END IF          
     1045         ! Save integrated transport for next computation 
    10321046         ub2_b(:,:) = zwx(:,:) 
    10331047         vb2_b(:,:) = zwy(:,:) 
    … …  
    10651079      DO jk = 1, jpkm1 
    10661080         ! Correct velocities: 
    1067          un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 
    1068          vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 
     1081         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:)*r1_hu_n(:,:) - un_b(:,:) ) * umask(:,:,jk) 
     1082         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:)*r1_hv_n(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 
    10691083         ! 
    10701084      END DO 
    10711085      ! 
    1072       CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current 
    1073       CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic i-current 
     1086      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu_n(:,:) )    ! barotropic i-current 
     1087      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv_n(:,:) )    ! barotropic i-current 
    10741088      ! 
    10751089#if defined key_agrif 
    … …  
    12001214         CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:) )    
    12011215         CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:) )  
     1216         CALL iom_get( numror, jpdom_autoglo, 'un_bf'  , un_bf  (:,:) )    
     1217         CALL iom_get( numror, jpdom_autoglo, 'vn_bf'  , vn_bf  (:,:) )  
    12021218         IF( .NOT.ln_bt_av ) THEN 
    12031219            CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:) )    
    … …  
    12191235         CALL iom_rstput( kt, nitrst, numrow, 'ub2_b'   , ub2_b  (:,:) ) 
    12201236         CALL iom_rstput( kt, nitrst, numrow, 'vb2_b'   , vb2_b  (:,:) ) 
     1237         CALL iom_rstput( kt, nitrst, numrow, 'un_bf'   , un_bf  (:,:) ) 
     1238         CALL iom_rstput( kt, nitrst, numrow, 'vn_bf'   , vn_bf  (:,:) ) 
    12211239         ! 
    12221240         IF (.NOT.ln_bt_av) THEN 
    … …  
    12971315#if defined key_agrif 
    12981316      ! Restrict the use of Agrif to the forward case only 
    1299       IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 
     1317!!!      IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 
    13001318#endif 
    13011319      ! 
    … …  
    13131331      IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax 
    13141332      ! 
     1333      IF(lwp) WRITE(numout,*)    '     Time diffusion parameter rn_bt_alpha: ', rn_bt_alpha 
     1334      IF ((ln_bt_av.AND.nn_bt_flt/=0).AND.(rn_bt_alpha>0._wp)) THEN 
     1335         CALL ctl_stop( 'dynspg_ts ERROR: if rn_bt_alpha > 0, remove temporal averaging' ) 
     1336      ENDIF 
     1337      ! 
    13151338      IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN 
    13161339         CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r7753 r8973  
    109109      !  
    110110      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
    111  
     111      ! 
     112#if defined key_agrif 
     113      CALL agrif_ssh( kt ) 
     114#endif 
     115      ! 
    112116      IF ( .NOT.ln_dynspg_ts ) THEN 
    113          ! These lines are not necessary with time splitting since 
    114          ! boundary condition on sea level is set during ts loop 
    115 # if defined key_agrif 
    116          CALL agrif_ssh( kt ) 
    117 # endif 
    118117         IF( ln_bdy ) THEN 
    119118            CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary 
    … …  
    215214      ENDIF 
    216215      ! 
     216#if defined key_agrif  
     217      IF( .NOT. AGRIF_Root() ) THEN  
     218         IF ((nbondi ==  1).OR.(nbondi == 2)) wn(nlci-1 , :     ,:) = 0.e0      ! east  
     219         IF ((nbondi == -1).OR.(nbondi == 2)) wn(2      , :     ,:) = 0.e0      ! west  
     220         IF ((nbondj ==  1).OR.(nbondj == 2)) wn(:      ,nlcj-1 ,:) = 0.e0      ! north  
     221         IF ((nbondj == -1).OR.(nbondj == 2)) wn(:      ,2      ,:) = 0.e0      ! south  
     222      ENDIF  
     223#endif  
     224      ! 
    217225      IF( nn_timing == 1 )  CALL timing_stop('wzv') 
    218226      ! 
    … …  
    252260      ENDIF 
    253261      !              !==  Euler time-stepping: no filter, just swap  ==! 
    254       IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    & 
    255          & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN  
     262      IF  ( neuler == 0 .AND. kt == nit000 ) THEN 
    256263         sshb(:,:) = sshn(:,:)                              ! before <-- now 
    257264         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now) 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

    r7646 r8973  
    1616   USE ioipsl         ! NetCDF IPSL library 
    1717   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     18   USE wrk_nemo       ! 
    1819 
    1920   IMPLICIT NONE 
    … …  
    3031 
    3132   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot 
    32  
     33   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_load, phi_load 
     34  
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    … …  
    4951      IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day 
    5052         ! 
    51          IF( kt == nit000 ) THEN 
     53         IF( kt == nit000 )THEN 
    5254            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      & 
    5355               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   ) 
     56            IF( ln_read_load )THEN 
     57               ALLOCATE( amp_load(jpi,jpj,nb_harmo), phi_load(jpi,jpj,nb_harmo) ) 
     58               CALL tide_init_load 
     59            ENDIF 
    5460         ENDIF 
    5561         ! 
    56          amp_pot(:,:,:) = 0._wp 
    57          phi_pot(:,:,:) = 0._wp 
     62         IF( ln_read_load )THEN 
     63            amp_pot(:,:,:) = amp_load(:,:,:) 
     64            phi_pot(:,:,:) = phi_load(:,:,:) 
     65         ELSE  
     66            amp_pot(:,:,:) = 0._wp 
     67            phi_pot(:,:,:) = 0._wp 
     68         ENDIF 
    5869         pot_astro(:,:) = 0._wp 
    5970         ! 
    … …  
    101112         DO ji = 1, jpi 
    102113            DO jj = 1, jpj 
    103                ztmp1 =  amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) ) 
    104                ztmp2 = -amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) ) 
     114               ztmp1 =  ftide(jk) * amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) + v0tide(jk) + utide(jk) ) 
     115               ztmp2 = -ftide(jk) * amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) + v0tide(jk) + utide(jk) ) 
    105116               zlat = gphit(ji,jj)*rad !! latitude en radian 
    106117               zlon = glamt(ji,jj)*rad !! longitude en radian 
    … …  
    123134   END SUBROUTINE tide_init_potential 
    124135 
     136   SUBROUTINE tide_init_load 
     137      !!---------------------------------------------------------------------- 
     138      !!                 ***  ROUTINE tide_init_load  *** 
     139      !!---------------------------------------------------------------------- 
     140      INTEGER :: inum                 ! Logical unit of input file 
     141      INTEGER :: ji, jj, itide        ! dummy loop indices 
     142      REAL(wp), POINTER, DIMENSION(:,:) ::   ztr, zti   !: workspace to read in tidal harmonics data  
     143      !!---------------------------------------------------------------------- 
     144      IF(lwp) THEN 
     145         WRITE(numout,*) 
     146         WRITE(numout,*) 'tide_init_load : Initialization of load potential from file' 
     147         WRITE(numout,*) '~~~~~~~~~~~~~~ ' 
     148      ENDIF 
     149      ! 
     150      CALL wrk_alloc( jpi, jpj, zti, ztr ) 
     151      ! 
     152      CALL iom_open ( cn_tide_load , inum ) 
     153      ! 
     154      DO itide = 1, nb_harmo 
     155         CALL iom_get  ( inum, jpdom_data,TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
     156         CALL iom_get  ( inum, jpdom_data,TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 
     157         ! 
     158         DO ji=1,jpi 
     159            DO jj=1,jpj 
     160               amp_load(ji,jj,itide) =  SQRT( ztr(ji,jj)**2. + zti(ji,jj)**2. ) 
     161               phi_load(ji,jj,itide) = ATAN2(-zti(ji,jj), ztr(ji,jj) ) 
     162            END DO 
     163         END DO 
     164         ! 
     165      END DO 
     166      CALL iom_close( inum ) 
     167      ! 
     168      CALL wrk_dealloc( jpi, jpj, zti, ztr ) 
     169      ! 
     170   END SUBROUTINE tide_init_load 
     171 
    125172  !!====================================================================== 
    126173END MODULE sbctide 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    r7646 r8973  
    88   USE oce            ! ocean dynamics and tracers variables 
    99   USE dom_oce        ! ocean space and time domain 
    10    USE phycst         ! physical constant 
    11    USE daymod         ! calandar 
     10   USE phycst         ! physical constants 
     11   USE daymod         ! calendar 
    1212   USE tide_mod       !  
    1313   ! 
    … …  
    2727   LOGICAL , PUBLIC ::   ln_tide         !: 
    2828   LOGICAL , PUBLIC ::   ln_tide_pot     !: 
     29   LOGICAL , PUBLIC ::   ln_read_load    !: 
     30   LOGICAL , PUBLIC ::   ln_scal_load    !: 
    2931   LOGICAL , PUBLIC ::   ln_tide_ramp    !: 
    3032   INTEGER , PUBLIC ::   nb_harmo        !: 
    3133   INTEGER , PUBLIC ::   kt_tide         !: 
    3234   REAL(wp), PUBLIC ::   rdttideramp     !: 
    33     
     35   REAL(wp), PUBLIC ::   rn_scal_load    !: 
     36   CHARACTER(lc), PUBLIC ::   cn_tide_load   !:  
     37 
    3438   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !: 
    3539 
    … …  
    4953      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    5054      ! 
    51       NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_tide_ramp, rdttideramp, clname 
     55      NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_scal_load, ln_read_load, cn_tide_load, & 
     56                  &     ln_tide_ramp, rn_scal_load, rdttideramp, clname 
    5257      !!---------------------------------------------------------------------- 
    5358      ! 
    … …  
    6974            WRITE(numout,*) '   Namelist nam_tide' 
    7075            WRITE(numout,*) '              Use tidal components : ln_tide      = ', ln_tide 
    71             WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  = ', ln_tide_pot 
    72             WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo 
    73             WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp 
    74             WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp 
     76            WRITE(numout,*) '      Apply astronomical potential          : ln_tide_pot  = ', ln_tide_pot 
     77            WRITE(numout,*) '      Use scalar approx. for load potential : ln_scal_load = ', ln_scal_load 
     78            WRITE(numout,*) '      Read load potential from file         : ln_read_load = ', ln_read_load 
     79            WRITE(numout,*) '      Apply ramp on tides at startup        : ln_tide_ramp = ', ln_tide_ramp 
     80            WRITE(numout,*) '      Fraction of SSH used in scal. approx. : rn_scal_load = ', rn_scal_load 
     81            WRITE(numout,*) '      Duration (days) of ramp               : rdttideramp  = ', rdttideramp 
    7582         ENDIF 
    7683      ELSE 
    … …  
    93100      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 
    94101      ! 
     102      IF( ln_read_load.AND.(.NOT.ln_tide_pot) ) & 
     103          &   CALL ctl_stop('ln_read_load requires ln_tide_pot') 
     104      IF( ln_scal_load.AND.(.NOT.ln_tide_pot) ) & 
     105          &   CALL ctl_stop('ln_scal_load requires ln_tide_pot') 
     106      IF( ln_scal_load.AND.ln_read_load ) & 
     107          &   CALL ctl_stop('Choose between ln_scal_load and ln_read_load') 
    95108      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   & 
    96109         &   CALL ctl_stop('rdttideramp must be lower than run duration') 
    … …  
    112125      kt_tide = nit000 
    113126      ! 
     127      IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp 
     128      ! 
    114129   END SUBROUTINE tide_init 
    115130      

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90

    r7753 r8973  
    9393      zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
    9494      zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     95 
     96#if defined key_agrif 
     97      ! ! Upper left longitude and latitude from parent: 
     98      IF (.NOT.Agrif_root()) THEN 
     99         zlam0 = zlam1 + Agrif_irhox() * REAL(Agrif_Parent(jpjglo)-2 , wp) * ze1deg * zcos_alpha  & 
     100                   &   + ( Agrif_Ix()*Agrif_irhox()-(0.5_wp+nbghostcells)) * ze1deg * zcos_alpha  & 
     101                   &   + ( Agrif_Iy()*Agrif_irhoy()-(0.5_wp+nbghostcells)) * ze1deg * zsin_alpha 
     102         zphi0 = zphi1 + Agrif_irhoy() * REAL(Agrif_Parent(jpjglo)-2 , wp) * ze1deg * zsin_alpha  & 
     103                   &   - ( Agrif_Ix()*Agrif_irhox()-nbghostcells )         * ze1deg * zsin_alpha  & 
     104                   &   + ( Agrif_Iy()*Agrif_irhoy()-nbghostcells )         * ze1deg * zcos_alpha 
     105      ENDIF  
     106#endif 
    95107      !    
    96108      IF( ln_bench ) THEN     ! benchmark: forced the resolution to be 106 km  

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90

    r7715 r8973  
    7070      ! 
    7171      cd_cfg = 'GYRE'               ! name & resolution (not used) 
     72#if defined key_agrif 
     73      IF (.NOT.Agrif_root()) nn_GYRE = Agrif_parent(nn_GYRE) * Agrif_irhox() 
     74#endif 
    7275      kk_cfg = nn_GYRE 
    7376      ! 
    7477      kpi = 30 * nn_GYRE + 2        ! Global Domain size 
    7578      kpj = 20 * nn_GYRE + 2 
     79#if defined key_agrif 
     80      IF( .NOT. Agrif_Root() ) THEN 
     81         kpi  = nbcellsx + 2 + 2*nbghostcells 
     82         kpj  = nbcellsy + 2 + 2*nbghostcells 
     83      ENDIF 
     84#endif 
    7685      kpk = jpkglo 
    7786      ! 
    … …  
    8392      WRITE(ldtxt(ii),*) '      GYRE used as Benchmark (=T)                      ln_bench  = ', ln_bench  ;   ii = ii + 1 
    8493      WRITE(ldtxt(ii),*) '      inverse resolution & implied domain size         nn_GYRE   = ', nn_GYRE   ;   ii = ii + 1 
     94#if defined key_agrif 
     95      IF( Agrif_Root() ) THEN 
     96#endif 
    8597      WRITE(ldtxt(ii),*) '         jpiglo = 30*nn_GYRE+2                            jpiglo = ', kpi       ;   ii = ii + 1 
    8698      WRITE(ldtxt(ii),*) '         jpjglo = 20*nn_GYRE+2                            jpjglo = ', kpj       ;   ii = ii + 1 
     99#if defined key_agrif 
     100      ENDIF 
     101#endif 
    87102      WRITE(ldtxt(ii),*) '      number of model levels                              jpkglo = ', kpk       ;   ii = ii + 1 
    88103      ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r7646 r8973  
    3333   USE iom            ! I/O manager library 
    3434   USE timing         ! Timing 
    35    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     35   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
     36#if defined key_agrif 
     37   USE agrif_opa_interp ! Set bc on avm 
     38#endif  
    3639 
    3740   IMPLICIT NONE 
    … …  
    204207         DO jj = 2, jpjm1 
    205208            DO ji = fs_2, fs_jpim1   ! vector opt. 
    206                avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   & 
    207                   &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
    208                   &                            / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 
    209                avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   & 
    210                   &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   & 
    211                   &                            / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 
     209!               avmu(ji,jj,jk) =   avmu(ji,jj,jk) & 
     210               avmu(ji,jj,jk) = 0.5_wp * ( avm(ji,jj,jk) + avm(ji+1,jj,jk) ) * umask(ji,jj,jk)  & 
     211                  &                    * ( un(ji,jj,jk-1) - un(ji,jj,jk)   )   & 
     212                  &                    * ( ub(ji,jj,jk-1) - ub(ji,jj,jk)   )   & 
     213                  &                    / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 
     214!               avmv(ji,jj,jk) =   avmv(ji,jj,jk) & 
     215               avmv(ji,jj,jk) = 0.5_wp * ( avm(ji,jj,jk) + avm(ji,jj+1,jk) ) * vmask(ji,jj,jk)  &  
     216                  &                    * ( vn(ji,jj,jk-1) - vn(ji,jj,jk)   )   & 
     217                  &                    * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )     & 
     218                  &                    / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 
    212219               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk) 
    213220            END DO 
    … …  
    800807      ! Lateral boundary conditions (sign unchanged) 
    801808      avt(:,:,1)  = 0._wp 
     809      ! 
     810#if defined key_agrif  
     811      CALL Agrif_avm  
     812#endif 
     813      ! 
    802814      CALL lbc_lnk( avm, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. ) 
    803815 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7813 r8973  
    173173      !!---------------------------------------------------------------------- 
    174174      ! 
    175 #if defined key_agrif  
    176       ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
    177       IF( .NOT.Agrif_Root() )   CALL Agrif_Tke 
    178 #endif 
    179       ! 
    180175      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
    181176         avt (:,:,:) = avt_k (:,:,:)  
    … …  
    196191#if defined key_agrif 
    197192      ! Update child grid f => parent grid  
    198       IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only 
     193!!! JC: suppress update since restartability is not possible in that case 
     194!!!      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke(kt)      ! children only 
    199195#endif       
    200196     !  
    … …  
    666662         END DO 
    667663      END DO 
     664      ! 
     665#if defined key_agrif  
     666      CALL Agrif_avm  
     667#endif 
     668      ! 
    668669      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    669670      ! 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8570 r8973  
    606606         &                                               'Compile with key_nosignedzero enabled' ) 
    607607      ! 
     608#if defined key_agrif 
     609      IF( nn_timing == 1 ) CALL ctl_stop( 'AGRIF not implemented with nn_timing = 1') 
     610#endif 
     611      ! 
    608612   END SUBROUTINE nemo_ctl 
    609613 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r7646 r8973  
    4545   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth 
    4646   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T) 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_bf  , vn_bf           !: Asselin filtered half step fluxes (ln_bt_fw=T) 
    4748#if defined key_agrif 
    4849   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes  
    … …  
    119120         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) ) 
    120121         ! 
    121       ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) ) 
     122      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj)      , STAT=ierr(6) ) 
    122123#if defined key_agrif 
    123124      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(7) ) 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7753 r8973  
    315315      IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update  
    316316!!jc in fact update is useless at last time step, but do it for global diagnostics 
    317                          CALL Agrif_Update_Tra()      ! Update active tracers 
    318                          CALL Agrif_Update_Dyn()      ! Update momentum 
     317                             CALL Agrif_Update_ssh()      ! Update ssh 
     318         IF(.NOT.ln_linssh)  CALL Agrif_Update_vvl()      ! Update vertical scale factors   
     319                             CALL Agrif_Update_Tra()      ! Update active tracers 
     320                             CALL Agrif_Update_Dyn()      ! Update momentum 
     321#if defined key_top 
     322                             CALL Agrif_Update_Trc()      ! Update passive tracers 
     323#endif 
    319324      ENDIF 
    320325#endif 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r7646 r8973  
    113113   USE agrif_opa_sponge ! Momemtum and tracers sponges 
    114114   USE agrif_opa_update ! Update (2-way nesting) 
     115#if defined key_top 
     116   USE agrif_top_update ! passive tracers update (2-way nesting) 
     117#endif 
    115118#endif 
    116119#if defined key_top 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r7646 r8973  
    3030#if defined key_agrif 
    3131   USE agrif_top_sponge ! tracers sponges 
    32    USE agrif_top_update ! tracers updates 
    3332#endif 
    3433 
    … …  
    8382         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only 
    8483 
    85 #if defined key_agrif 
    86          IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 
    87 #endif 
    8884         ! 
    8985      ELSE                                               ! 1D vertical configuration 

  • branches/2017/dev_MERCATOR_2017/NEMOGCM/SETTE/sette.sh

    r8830 r8973  
    805805    set_namelist namelist_cfg ln_read_cfg .true. 
    806806    set_namelist namelist_cfg ln_linssh .true. 
    807     set_namelist namelist_cfg nn_fsbc 1 
    808807    set_namelist namelist_cfg nn_fwb 0 
    809808    set_namelist namelist_cfg jpni 4 
    … …  
    829828    set_namelist namelist_cfg ln_read_cfg .true. 
    830829    set_namelist namelist_cfg ln_linssh .true. 
    831     set_namelist namelist_cfg nn_fsbc 1 
    832830    set_namelist namelist_cfg nn_fwb 0 
    833831    set_namelist namelist_cfg jpni 4 
    … …  
    11161114    set_namelist namelist_cfg ln_clobber .true. 
    11171115    set_namelist namelist_cfg ln_read_cfg .true. 
    1118     set_namelist namelist_cfg ln_linssh .true. 
    1119     set_namelist namelist_cfg ln_hpg_sco .false. 
    1120     set_namelist namelist_cfg ln_hpg_zps .true.  
     1116    set_namelist namelist_cfg ln_linssh .false. 
    11211117    set_namelist namelist_cfg nn_fwb 0 
    11221118    set_namelist namelist_cfg jpni 1 
    … …  
    11281124    set_namelist 1_namelist_cfg ln_clobber .true. 
    11291125    set_namelist 1_namelist_cfg ln_read_cfg .true. 
    1130     set_namelist 1_namelist_cfg ln_linssh .true. 
    1131     set_namelist 1_namelist_cfg ln_hpg_sco .false. 
    1132     set_namelist 1_namelist_cfg ln_hpg_zps .true.  
     1126    set_namelist 1_namelist_cfg ln_linssh .false. 
    11331127    if [ ${USING_MPMD} == "yes" ] ; then 
    11341128       set_xio_using_server iodef.xml true 
    … …  
    11621156    set_namelist namelist_cfg ln_clobber .true. 
    11631157    set_namelist namelist_cfg ln_read_cfg .true. 
    1164     set_namelist namelist_cfg ln_linssh .true. 
    1165     set_namelist namelist_cfg ln_hpg_sco .false. 
    1166     set_namelist namelist_cfg ln_hpg_zps .true.  
     1158    set_namelist namelist_cfg ln_linssh .false. 
    11671159    set_namelist namelist_cfg nn_fwb 0 
    11681160    set_namelist namelist_cfg jpni 2 
    11691161    set_namelist namelist_cfg jpnj 2 
    11701162    set_namelist namelist_cfg jpnij 4 
     1163    set_namelist namelist_cfg ln_icebergs .false. 
    11711164#  
    11721165#   Set the number of fine grids to zero:     
    … …  
    11991192    set_namelist namelist_cfg ln_clobber .true. 
    12001193    set_namelist namelist_cfg ln_read_cfg .true. 
    1201     set_namelist namelist_cfg ln_linssh .true. 
    1202     set_namelist namelist_cfg ln_hpg_sco .false. 
    1203     set_namelist namelist_cfg ln_hpg_zps .true.  
     1194    set_namelist namelist_cfg ln_linssh .false. 
    12041195    set_namelist namelist_cfg nn_fwb 0 
    12051196    set_namelist namelist_cfg jpni 2 
    12061197    set_namelist namelist_cfg jpnj 2 
    12071198    set_namelist namelist_cfg jpnij 4 
     1199    set_namelist namelist_cfg ln_icebergs .false. 
    12081200# 
    12091201    if [ ${USING_MPMD} == "yes" ] ; then 
    … …  
    12381230    set_namelist namelist_cfg ln_clobber .true. 
    12391231    set_namelist namelist_cfg ln_read_cfg .true. 
    1240     set_namelist namelist_cfg ln_linssh .true. 
    1241     set_namelist namelist_cfg ln_hpg_sco .false. 
    1242     set_namelist namelist_cfg ln_hpg_zps .true.  
     1232    set_namelist namelist_cfg ln_linssh .false. 
    12431233    set_namelist namelist_cfg nn_fwb 0 
    12441234    set_namelist namelist_cfg jpni 2 
    … …  
    12531243    set_namelist 1_namelist_cfg ln_clobber .true. 
    12541244    set_namelist 1_namelist_cfg ln_read_cfg .true. 
    1255     set_namelist 1_namelist_cfg ln_linssh .true. 
    1256     set_namelist 1_namelist_cfg ln_hpg_sco .false. 
    1257     set_namelist 1_namelist_cfg ln_hpg_zps .true.  
     1245    set_namelist 1_namelist_cfg ln_linssh .false. 
    12581246# 
    12591247    if [ ${USING_MPMD} == "yes" ] ; then 
    … …  
    12771265    set_namelist namelist_cfg ln_clobber .true. 
    12781266    set_namelist namelist_cfg ln_read_cfg .true. 
    1279     set_namelist namelist_cfg ln_linssh .true. 
    1280     set_namelist namelist_cfg ln_hpg_sco .false. 
    1281     set_namelist namelist_cfg ln_hpg_zps .true.  
     1267    set_namelist namelist_cfg ln_linssh .false. 
    12821268    set_namelist namelist_cfg nn_fwb 0 
    12831269    set_namelist namelist_cfg jpni 2 
    … …  
    12931279    set_namelist 1_namelist_cfg ln_clobber .true. 
    12941280    set_namelist 1_namelist_cfg ln_read_cfg .true. 
    1295     set_namelist 1_namelist_cfg ln_linssh .true. 
    1296     set_namelist 1_namelist_cfg ln_hpg_sco .false. 
    1297     set_namelist 1_namelist_cfg ln_hpg_zps .true.  
     1281    set_namelist 1_namelist_cfg ln_linssh .false. 
    12981282    set_namelist namelist_cfg cn_ocerst_in \"O2LP_LONG_00000075_restart\" 
    12991283    set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\" 
    … …  
    13381322    set_namelist namelist_cfg ln_clobber .true. 
    13391323    set_namelist namelist_cfg ln_read_cfg .true. 
    1340     set_namelist namelist_cfg ln_linssh .true. 
    1341     set_namelist namelist_cfg ln_hpg_sco .false. 
    1342     set_namelist namelist_cfg ln_hpg_zps .true.  
     1324    set_namelist namelist_cfg ln_linssh .false. 
    13431325    set_namelist namelist_cfg nn_fwb 0 
    13441326    set_namelist namelist_cfg jpni 4 
    … …  
    13511333    set_namelist 1_namelist_cfg ln_clobber .true. 
    13521334    set_namelist 1_namelist_cfg ln_read_cfg .true. 
    1353     set_namelist 1_namelist_cfg ln_linssh .true. 
    1354     set_namelist 1_namelist_cfg ln_hpg_sco .false. 
    1355     set_namelist 1_namelist_cfg ln_hpg_zps .true.  
     1335    set_namelist 1_namelist_cfg ln_linssh .false. 
    13561336 
    13571337    if [ ${USING_MPMD} == "yes" ] ; then 
    … …  
    13771357    set_namelist namelist_cfg ln_clobber .true. 
    13781358    set_namelist namelist_cfg ln_read_cfg .true. 
    1379     set_namelist namelist_cfg ln_linssh .true. 
    1380     set_namelist namelist_cfg ln_hpg_sco .false. 
    1381     set_namelist namelist_cfg ln_hpg_zps .true.  
     1359    set_namelist namelist_cfg ln_linssh .false. 
    13821360    set_namelist namelist_cfg nn_fwb 0 
    13831361    set_namelist namelist_cfg jpni 2 
    … …  
    13901368    set_namelist 1_namelist_cfg ln_clobber .true. 
    13911369    set_namelist 1_namelist_cfg ln_read_cfg .true. 
    1392     set_namelist 1_namelist_cfg ln_linssh .true. 
    1393     set_namelist 1_namelist_cfg ln_hpg_sco .false. 
    1394     set_namelist 1_namelist_cfg ln_hpg_zps .true.  
     1370    set_namelist 1_namelist_cfg ln_linssh .false. 
    13951371 
    13961372    if [ ${USING_MPMD} == "yes" ] ; then 
Note: See TracChangeset for help on using the changeset viewer.