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 9031 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2017-12-14T11:10:02+01:00 (6 years ago)
Author:
timgraham
Message:

Resolved AGRIF conflicts

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r9019 r9031  
     1#define 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 
     
    149154   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
    150155 
    151    ! 5. Update type 
     156   ! 4. Update type 
    152157   !---------------  
    153    CALL Agrif_Set_Updatetype( e1u_id, update1=Agrif_Update_Copy   , update2=Agrif_Update_Average ) 
    154    CALL Agrif_Set_Updatetype( e2v_id, update1=Agrif_Update_Average, update2=Agrif_Update_Copy    ) 
    155  
    156 ! High order updates 
    157 !   CALL Agrif_Set_Updatetype( e1u_id, update1=Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting ) 
    158 !   CALL Agrif_Set_Updatetype( e2v_id, update1=Agrif_Update_Full_Weighting, update2=Agrif_Update_Average        ) 
    159     ! 
     158# if defined UPD_HIGH 
     159   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
     160   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
     161#else 
     162   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     163   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     164#endif 
     165 
    160166END SUBROUTINE agrif_declare_var_dom 
    161167 
     
    182188   ! 
    183189   LOGICAL :: check_namelist 
    184    CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 
     190   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    185191   !!---------------------------------------------------------------------- 
    186192 
     
    212218   Agrif_UseSpecialValue = .TRUE. 
    213219   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
     220   hbdy_w(:) = 0.e0 ; hbdy_e(:) = 0.e0 ; hbdy_n(:) = 0.e0 ; hbdy_s(:) = 0.e0 
     221   ssha(:,:) = 0.e0 
    214222 
    215223   IF ( ln_dynspg_ts ) THEN 
     
    219227      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    220228      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    221       ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
    222       ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
    223       ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
    224       ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
     229      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 
     230      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 
     231      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 
     232      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 
    225233   ENDIF 
    226234 
     
    241249         WRITE(cl_check2,*)  NINT(rdt) 
    242250         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
    243          CALL ctl_stop( 'incompatible time step between ocean grids',   & 
     251         CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    244252               &               'parent grid value : '//cl_check1    ,   &  
    245253               &               'child  grid value : '//cl_check2    ,   &  
     
    252260         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    253261         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    254          CALL ctl_warn( 'incompatible run length between grids'               ,   & 
    255                &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
    256                &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     262         CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
     263               &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
     264               &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    257265         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    258266         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    259267      ENDIF 
    260  
    261       ! Check coordinates 
    262      !SF  IF( ln_zps ) THEN 
    263      !SF     ! check parameters for partial steps  
    264      !SF     IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    265      !SF        WRITE(*,*) 'incompatible e3zps_min between grids' 
    266      !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    267      !SF        WRITE(*,*) 'child grid  :',e3zps_min 
    268      !SF        WRITE(*,*) 'those values should be identical' 
    269      !SF        STOP 
    270      !SF     ENDIF 
    271      !SF     IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    272      !SF        WRITE(*,*) 'incompatible e3zps_rat between grids' 
    273      !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    274      !SF        WRITE(*,*) 'child grid  :',e3zps_rat 
    275      !SF        WRITE(*,*) 'those values should be identical'                   
    276      !SF        STOP 
    277      !SF     ENDIF 
    278      !SF  ENDIF 
    279268 
    280269      ! Check free surface scheme 
    281270      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
    282271         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
    283          WRITE(*,*) 'incompatible free surface scheme between grids' 
    284          WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts ) 
    285          WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 
    286          WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts 
    287          WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp 
    288          WRITE(*,*) 'those logicals should be identical'                   
     272         WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts ) 
     273         WRITE(cl_check2,*)  ln_dynspg_ts 
     274         WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp ) 
     275         WRITE(cl_check4,*)  ln_dynspg_exp 
     276         CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  & 
     277               &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  &  
     278               &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  & 
     279               &               'parent grid ln_dynspg_exp :'//cl_check3  ,  & 
     280               &               'child  grid ln_dynspg_exp :'//cl_check4  ,  & 
     281               &               'those logicals should be identical' )                  
     282         STOP 
     283      ENDIF 
     284 
     285      ! Check if identical linear free surface option 
     286      IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 
     287         & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 
     288         WRITE(cl_check1,*)  Agrif_Parent(ln_linssh ) 
     289         WRITE(cl_check2,*)  ln_linssh 
     290         CALL ctl_stop( 'Incompatible linearized fs option between grids',  & 
     291               &               'parent grid ln_linssh  :'//cl_check1     ,  & 
     292               &               'child  grid ln_linssh  :'//cl_check2     ,  & 
     293               &               'those logicals should be identical' )                   
    289294         STOP 
    290295      ENDIF 
     
    313318   ENDIF 
    314319   !  
    315    ! Do update at initialisation because not done before writing restarts 
    316    ! This would indeed change boundary conditions values at initial time 
    317    ! hence produce restartability issues. 
    318    ! Note that update below is recursive (with lk_agrif_doupd=T): 
    319    !  
    320 ! JC: I am not sure if Agrif_MaxLevel() is the "relative" 
    321 !     or the absolute maximum nesting level...TBC                         
    322    IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN  
    323       ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 
    324       CALL Agrif_Update_tra() 
    325       CALL Agrif_Update_dyn() 
    326    ENDIF 
    327    ! 
    328    Agrif_UseSpecialValueInUpdate = .FALSE. 
    329    nbcline = 0 
    330    lk_agrif_doupd = .FALSE. 
    331    ! 
    332320END SUBROUTINE Agrif_InitValues_cont 
    333321 
     322RECURSIVE SUBROUTINE Agrif_Update_ini( ) 
     323   !!---------------------------------------------------------------------- 
     324   !!                 *** ROUTINE agrif_Update_ini *** 
     325   !! 
     326   !! ** Purpose :: Recursive update done at initialization 
     327   !!---------------------------------------------------------------------- 
     328   USE dom_oce 
     329   USE agrif_opa_update 
     330#if defined key_top 
     331   USE agrif_top_update 
     332#endif 
     333   ! 
     334   IMPLICIT NONE 
     335   !!---------------------------------------------------------------------- 
     336   ! 
     337   IF (Agrif_Root()) RETURN 
     338   ! 
     339   IF (.NOT.ln_linssh) CALL Agrif_Update_vvl() 
     340   CALL Agrif_Update_tra() 
     341#if defined key_top 
     342   CALL Agrif_Update_Trc() 
     343#endif 
     344   CALL Agrif_Update_dyn() 
     345! JC remove update because this precludes from perfect restartability 
     346!!   CALL Agrif_Update_tke(0) 
     347 
     348   CALL Agrif_ChildGrid_To_ParentGrid() 
     349   CALL Agrif_Update_ini() 
     350   CALL Agrif_ParentGrid_To_ChildGrid() 
     351 
     352END SUBROUTINE agrif_update_ini 
    334353 
    335354SUBROUTINE agrif_declare_var 
     
    355374   ind2 = 1 + nbghostcells 
    356375   ind3 = 2 + nbghostcells 
     376# if defined key_vertical 
     377   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
     378   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
     379 
     380   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
     381   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
     382   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
     383   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
     384   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
     385   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
     386# else 
    357387   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    358388   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    359389 
    360    CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
    361    CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
    362    CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
    363    CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
    364    CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
    365    CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
     390   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
     391   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
     392   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
     393   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
     394   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
     395   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
     396# endif 
    366397 
    367398   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     
    383414      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    384415      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    385       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     416# if defined key_vertical 
     417   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
     418# else 
     419   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     420# endif 
    386421   ENDIF 
    387422 
     
    433468   IF( ln_zdftke )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    434469 
    435    ! 5. Update type 
     470   ! 4. Update type 
    436471   !---------------  
     472   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     473 
     474# if defined UPD_HIGH 
     475   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     476   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     477   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     478 
     479   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     480   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     481   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
     482   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
     483 
     484   IF( ln_zdftke) THEN 
     485      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
     486      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
     487      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
     488   ENDIF 
     489 
     490#else 
    437491   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    438  
    439    CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    440  
    441492   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    442493   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    443494 
    444    CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    445  
    446495   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    447496   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     497   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     498   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    448499 
    449500   IF( ln_zdftke) THEN 
     
    453504   ENDIF 
    454505 
    455 ! High order updates 
    456 !   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    457 !   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    458 !   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    459 ! 
    460 !   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    461 !   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    462 !   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
    463  
     506#endif 
    464507   ! 
    465508END SUBROUTINE agrif_declare_var 
     
    500543      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 
    501544   ENDIF 
    502  
    503    ! stop if update frequency is different from nn_fsbc 
    504    IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc') 
    505  
    506  
    507545   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1) 
    508546   !---------------------------------------------------------------------- 
     
    645683      ENDIF 
    646684 
    647       ! Check coordinates 
    648       IF( ln_zps ) THEN 
    649          ! check parameters for partial steps  
    650          IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    651             WRITE(*,*) 'incompatible e3zps_min between grids' 
    652             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    653             WRITE(*,*) 'child grid  :',e3zps_min 
    654             WRITE(*,*) 'those values should be identical' 
    655             STOP 
    656          ENDIF 
    657          IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN 
    658             WRITE(*,*) 'incompatible e3zps_rat between grids' 
    659             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    660             WRITE(*,*) 'child grid  :',e3zps_rat 
    661             WRITE(*,*) 'those values should be identical'                   
    662             STOP 
    663          ENDIF 
    664685      ENDIF 
    665686      ! Check passive tracer cell 
     
    668689      ENDIF 
    669690   ENDIF 
    670  
    671    CALL Agrif_Update_trc(0) 
    672    ! 
    673    Agrif_UseSpecialValueInUpdate = .FALSE. 
    674    nbcline_trc = 0 
    675691   ! 
    676692END SUBROUTINE Agrif_InitValues_cont_top 
     
    698714   ind2 = 1 + nbghostcells 
    699715   ind3 = 2 + nbghostcells 
    700    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
    701    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     716# if defined key_vertical 
     717   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
     718   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
     719# else 
     720   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
     721   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     722# endif 
    702723 
    703724   ! 2. Type of interpolation 
     
    711732   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    712733 
    713    ! 5. Update type 
     734   ! 4. Update type 
    714735   !---------------  
     736# if defined UPD_HIGH 
     737   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 
     738#else 
    715739   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    716  
    717 !   Higher order update 
    718 !   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    719  
     740#endif 
    720741   ! 
    721742END SUBROUTINE agrif_declare_var_top 
     
    748769   INTEGER  ::   ios                 ! Local integer output status for namelist read 
    749770   INTEGER  ::   iminspon 
    750    NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
     771   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
    751772   !!-------------------------------------------------------------------------------------- 
    752773   ! 
     
    765786      WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    766787      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    767       WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update 
    768788      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
    769789      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
     
    774794   ! 
    775795   ! convert DOCTOR namelist name into OLD names 
    776    nbclineupdate = nn_cln_update 
    777796   visc_tra      = rn_sponge_tra 
    778797   visc_dyn      = rn_sponge_dyn 
     
    791810SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    792811   !!---------------------------------------------------------------------- 
    793    !!                     *** ROUTINE Agrif_detect *** 
     812   !!                     *** ROUTINE Agrif_InvLoc *** 
    794813   !!---------------------------------------------------------------------- 
    795814   USE dom_oce 
Note: See TracChangeset for help on using the changeset viewer.