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.
agrif_user.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8288

Last change on this file since 8288 was 8226, checked in by clem, 7 years ago

merge with dev_r8127_AGRIF_LIM3_GHOST@r8189 and dev_r8126_ROBUST08_no_ghost@r8196

  • Property svn:keywords set to Id
File size: 39.1 KB
RevLine 
[393]1#if defined key_agrif
[3680]2!!----------------------------------------------------------------------
[7646]3!! NEMO/NST 3.7 , NEMO Consortium (2016)
[3680]4!! $Id$
5!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
6!!----------------------------------------------------------------------
7SUBROUTINE agrif_user
8END SUBROUTINE agrif_user
9
10SUBROUTINE agrif_before_regridding
11END SUBROUTINE agrif_before_regridding
12
13SUBROUTINE Agrif_InitWorkspace
[1156]14   !!----------------------------------------------------------------------
[3680]15   !!                 *** ROUTINE Agrif_InitWorkspace ***
[1156]16   !!----------------------------------------------------------------------
[3680]17   USE par_oce
18   USE dom_oce
19   USE nemogcm
[7646]20   !!
[3680]21   IMPLICIT NONE
22   !!----------------------------------------------------------------------
23   !
24   IF( .NOT. Agrif_Root() ) THEN
25      jpni = Agrif_Parent(jpni)
26      jpnj = Agrif_Parent(jpnj)
27      jpnij = Agrif_Parent(jpnij)
28      jpiglo  = nbcellsx + 2 + 2*nbghostcells
29      jpjglo  = nbcellsy + 2 + 2*nbghostcells
30      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
31      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
[5656]32! JC: change to allow for different vertical levels
33!     jpk is already set
[7646]34!     keep it jpk possibly different from jpkglo which
[5656]35!     hold parent grid vertical levels number (set earlier)
[7646]36!      jpk     = jpkglo
[4147]37      jpim1   = jpi-1 
38      jpjm1   = jpj-1 
[7761]39      jpkm1   = MAX( 1, jpk-1 )                                         
[4147]40      jpij    = jpi*jpj 
[3680]41      nperio  = 0
42      jperio  = 0
43   ENDIF
44   !
45END SUBROUTINE Agrif_InitWorkspace
[1156]46
[390]47
[3680]48SUBROUTINE Agrif_InitValues
49   !!----------------------------------------------------------------------
50   !!                 *** ROUTINE Agrif_InitValues ***
51   !!
52   !! ** Purpose :: Declaration of variables to be interpolated
53   !!----------------------------------------------------------------------
54   USE Agrif_Util
55   USE oce 
56   USE dom_oce
57   USE nemogcm
58   USE tradmp
[7646]59   USE bdy_oce   , ONLY: ln_bdy
60   !!
[3680]61   IMPLICIT NONE
62   !!----------------------------------------------------------------------
[7646]63   !
64!!gm  I think this is now useless ...   nn_cfg & cn_cfg are set to -999999 and "UNKNOWN"
65!!gm                                    when reading the AGRIF domain configuration file
66   IF( cn_cfg == 'orca' ) THEN
67      IF ( nn_cfg == 2 .OR. nn_cfg == 025 .OR. nn_cfg == 05  .OR. nn_cfg == 4 ) THEN
68         nn_cfg = -1    ! set special value for nn_cfg on fine grids
69         cn_cfg = "default"
[4147]70      ENDIF
71   ENDIF
[7646]72   !                    !* Specific fine grid Initializations
73   ln_tradmp = .FALSE.        ! no tracer damping on fine grids
74   !
75   ln_bdy    = .FALSE.        ! no open boundary on fine grids
[2031]76
[7646]77   CALL nemo_init       !* Initializations of each fine grid
[4147]78
[7646]79   !                    !* Agrif initialization
[3680]80   CALL agrif_nemo_init
81   CALL Agrif_InitValues_cont_dom
82   CALL Agrif_InitValues_cont
[2715]83# if defined key_top
[3680]84   CALL Agrif_InitValues_cont_top
[7646]85# endif
[7761]86# if defined key_lim3
87   CALL Agrif_InitValues_cont_lim3
88# endif
[7646]89   !
[3680]90END SUBROUTINE Agrif_initvalues
[2031]91
[3680]92
93SUBROUTINE Agrif_InitValues_cont_dom
94   !!----------------------------------------------------------------------
95   !!                 *** ROUTINE Agrif_InitValues_cont ***
96   !!
97   !! ** Purpose ::   Declaration of variables to be interpolated
98   !!----------------------------------------------------------------------
99   USE Agrif_Util
100   USE oce 
101   USE dom_oce
102   USE nemogcm
103   USE in_out_manager
104   USE agrif_opa_update
105   USE agrif_opa_interp
106   USE agrif_opa_sponge
[7646]107   !!
[3680]108   IMPLICIT NONE
[7646]109   !!----------------------------------------------------------------------
[3680]110   !
111   ! Declaration of the type of variable which have to be interpolated
[7646]112   !
[3680]113   CALL agrif_declare_var_dom
114   !
115END SUBROUTINE Agrif_InitValues_cont_dom
116
117
118SUBROUTINE agrif_declare_var_dom
119   !!----------------------------------------------------------------------
[5656]120   !!                 *** ROUTINE agrif_declare_var ***
[3680]121   !!
122   !! ** Purpose :: Declaration of variables to be interpolated
123   !!----------------------------------------------------------------------
124   USE agrif_util
[5656]125   USE par_oce       
[3680]126   USE oce
[7646]127   !!
[3680]128   IMPLICIT NONE
[8226]129   !
130   INTEGER :: ind1, ind2, ind3
[3680]131   !!----------------------------------------------------------------------
132
133   ! 1. Declaration of the type of variable which have to be interpolated
134   !---------------------------------------------------------------------
[8226]135   !!clem ghost
136   ind1 =     nbghostcells
137   ind2 = 1 + nbghostcells
138   ind3 = 2 + nbghostcells
139   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
140   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
141   !!clem ghost
[3680]142
143   ! 2. Type of interpolation
144   !-------------------------
[5656]145   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
146   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[3680]147
148   ! 3. Location of interpolation
149   !-----------------------------
[8226]150   !!clem ghost (previously set to /0,0/)
151   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
152   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
153   !!clem ghost
[3680]154
155   ! 5. Update type
156   !---------------
[5656]157   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
158   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
[3680]159
[5656]160! High order updates
161!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
162!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
163    !
[3680]164END SUBROUTINE agrif_declare_var_dom
165
166
167SUBROUTINE Agrif_InitValues_cont
168   !!----------------------------------------------------------------------
169   !!                 *** ROUTINE Agrif_InitValues_cont ***
170   !!
171   !! ** Purpose ::   Declaration of variables to be interpolated
172   !!----------------------------------------------------------------------
173   USE Agrif_Util
174   USE oce 
175   USE dom_oce
176   USE nemogcm
[5656]177   USE lib_mpp
[3680]178   USE in_out_manager
179   USE agrif_opa_update
180   USE agrif_opa_interp
181   USE agrif_opa_sponge
[7646]182   !!
[3680]183   IMPLICIT NONE
184   !
185   LOGICAL :: check_namelist
[5656]186   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
[3680]187   !!----------------------------------------------------------------------
[390]188
[3680]189   ! 1. Declaration of the type of variable which have to be interpolated
190   !---------------------------------------------------------------------
191   CALL agrif_declare_var
[636]192
[3680]193   ! 2. First interpolations of potentially non zero fields
194   !-------------------------------------------------------
195   Agrif_SpecialValue=0.
196   Agrif_UseSpecialValue = .TRUE.
[5656]197   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
198   CALL Agrif_Sponge
199   tabspongedone_tsn = .FALSE.
200   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
201   ! reset tsa to zero
202   tsa(:,:,:,:) = 0.
[390]203
[5656]204   Agrif_UseSpecialValue = ln_spc_dyn
205   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
206   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
207   tabspongedone_u = .FALSE.
208   tabspongedone_v = .FALSE.
209   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
210   tabspongedone_u = .FALSE.
211   tabspongedone_v = .FALSE.
212   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
[4326]213
[5656]214   Agrif_UseSpecialValue = .TRUE.
215   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
[628]216
[5930]217   IF ( ln_dynspg_ts ) THEN
218      Agrif_UseSpecialValue = ln_spc_dyn
219      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
220      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
221      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
222      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
223      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
224      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
225      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
226      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
227   ENDIF
[5656]228
229   Agrif_UseSpecialValue = .FALSE. 
230   ! reset velocities to zero
231   ua(:,:,:) = 0.
232   va(:,:,:) = 0.
233
[3680]234   ! 3. Some controls
235   !-----------------
[5656]236   check_namelist = .TRUE.
[3680]237
[5656]238   IF( check_namelist ) THEN 
[3680]239
240      ! Check time steps           
[5656]241      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
242         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
243         WRITE(cl_check2,*)  NINT(rdt)
244         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
[7646]245         CALL ctl_stop( 'incompatible time step between ocean grids',   &
[5656]246               &               'parent grid value : '//cl_check1    ,   & 
247               &               'child  grid value : '//cl_check2    ,   & 
[7646]248               &               'value on child grid should be changed to : '//cl_check3 )
[3680]249      ENDIF
250
251      ! Check run length
252      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[5656]253            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
254         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
255         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
256         CALL ctl_warn( 'incompatible run length between grids'               ,   &
257               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
258               &              ' nitend on fine grid will be change to : '//cl_check2    )
259         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
260         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
[3680]261      ENDIF
262
263      ! Check coordinates
[7646]264     !SF  IF( ln_zps ) THEN
265     !SF     ! check parameters for partial steps
266     !SF     IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
267     !SF        WRITE(*,*) 'incompatible e3zps_min between grids'
268     !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
269     !SF        WRITE(*,*) 'child grid  :',e3zps_min
270     !SF        WRITE(*,*) 'those values should be identical'
271     !SF        STOP
272     !SF     ENDIF
273     !SF     IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
274     !SF        WRITE(*,*) 'incompatible e3zps_rat between grids'
275     !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
276     !SF        WRITE(*,*) 'child grid  :',e3zps_rat
277     !SF        WRITE(*,*) 'those values should be identical'                 
278     !SF        STOP
279     !SF     ENDIF
280     !SF  ENDIF
[5930]281
282      ! Check free surface scheme
283      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
284         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
285         WRITE(*,*) 'incompatible free surface scheme between grids'
286         WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts )
287         WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp)
288         WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts
289         WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp
290         WRITE(*,*) 'those logicals should be identical'                 
291         STOP
292      ENDIF
293
[5656]294      ! check if masks and bathymetries match
295      IF(ln_chk_bathy) THEN
296         !
297         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
298         !
299         kindic_agr = 0
300         ! check if umask agree with parent along western and eastern boundaries:
301         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
302         ! check if vmask agree with parent along northern and southern boundaries:
303         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
[7761]304         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
[5656]305         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
306         !
307         IF (lk_mpp) CALL mpp_sum( kindic_agr )
[7761]308         IF( kindic_agr /= 0 ) THEN
[5656]309            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
310         ELSE
311            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
312         END IF
313      ENDIF
314      !
[3680]315   ENDIF
[5656]316   !
317   ! Do update at initialisation because not done before writing restarts
318   ! This would indeed change boundary conditions values at initial time
319   ! hence produce restartability issues.
320   ! Note that update below is recursive (with lk_agrif_doupd=T):
321   !
322! JC: I am not sure if Agrif_MaxLevel() is the "relative"
323!     or the absolute maximum nesting level...TBC                       
324   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
325      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
326      CALL Agrif_Update_tra()
327      CALL Agrif_Update_dyn()
328   ENDIF
329   !
330# if defined key_zdftke
331   CALL Agrif_Update_tke(0)
332# endif
333   !
334   Agrif_UseSpecialValueInUpdate = .FALSE.
[6140]335   nbcline = 0
[5656]336   lk_agrif_doupd = .FALSE.
[3680]337   !
338END SUBROUTINE Agrif_InitValues_cont
[1605]339
[3294]340
[3680]341SUBROUTINE agrif_declare_var
342   !!----------------------------------------------------------------------
343   !!                 *** ROUTINE agrif_declarE_var ***
344   !!
345   !! ** Purpose :: Declaration of variables to be interpolated
346   !!----------------------------------------------------------------------
347   USE agrif_util
[8226]348   USE par_oce       !   ONLY : jpts and ghostcells
[3680]349   USE oce
[5656]350   USE agrif_oce
[7646]351   !!
[3680]352   IMPLICIT NONE
[8226]353   !
354   INTEGER :: ind1, ind2, ind3
[3680]355   !!----------------------------------------------------------------------
[2715]356
[3680]357   ! 1. Declaration of the type of variable which have to be interpolated
358   !---------------------------------------------------------------------
[8226]359   !!clem ghost
360   ind1 =     nbghostcells
361   ind2 = 1 + nbghostcells
362   ind3 = 2 + nbghostcells
363   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)
364   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)
[2715]365
[8226]366   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
367   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
368   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
369   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
370   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
371   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
[2715]372
[8226]373   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
374   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
375   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
[2715]376
[8226]377   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
[5656]378
[8226]379   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
380   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
381   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
382   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
383   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
384   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
[5656]385
[8226]386   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
[5656]387
388# if defined key_zdftke
[8226]389   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
390   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
391   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
[5656]392# endif
[8226]393   !!clem ghost
[5656]394
[3680]395   ! 2. Type of interpolation
396   !-------------------------
397   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
[2715]398
[5656]399   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
400   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[2715]401
[5656]402   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
[2715]403
[4326]404   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
[5656]405   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
406   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
407   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
408   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[4326]409
[5656]410
411   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
412   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
413
414   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
415   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
416   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
417
418# if defined key_zdftke
419   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
420# endif
421
422
[3680]423   ! 3. Location of interpolation
424   !-----------------------------
[8226]425   !!clem ghost
426   CALL Agrif_Set_bc(tsn_id,(/0,ind1/))
427   CALL Agrif_Set_bc(un_interp_id,(/0,ind1/))
428   CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/))
[2715]429
[8226]430   ! clem: previously set to /-,0/
431   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9
[5656]432   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
433   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
[4326]434
[8226]435   CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/))
436   CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/))
437   CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/))
438   CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/))
439   CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/))
[2715]440
[8226]441   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/))   ! if west and rhox=3 and ghost=1: column 2 to 9
442   CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/))
443   CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/))
[2715]444
[8226]445   ! clem: previously set to /0,1/
[5656]446# if defined key_zdftke
[8226]447   CALL Agrif_Set_bc(avm_id ,(/0,ind1/))
[5656]448# endif
[8226]449   !!clem ghost
[5656]450
[3680]451   ! 5. Update type
452   !---------------
[5656]453   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
[2715]454
[5656]455   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
[2715]456
[5656]457   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
458   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
[3680]459
[5656]460   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
[4486]461
[5656]462   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
463   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
464
465# if defined key_zdftke
466   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
467   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
468   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
469# endif
470
471! High order updates
472!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
473!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
474!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
475!
476!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
477!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
478!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
[7761]479
[5656]480   !
[3680]481END SUBROUTINE agrif_declare_var
482
483#  if defined key_lim2
484SUBROUTINE Agrif_InitValues_cont_lim2
485   !!----------------------------------------------------------------------
486   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
487   !!
488   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
489   !!----------------------------------------------------------------------
490   USE Agrif_Util
491   USE ice_2
492   USE agrif_ice
493   USE in_out_manager
494   USE agrif_lim2_update
495   USE agrif_lim2_interp
496   USE lib_mpp
[7646]497   !!
[3680]498   IMPLICIT NONE
499   !!----------------------------------------------------------------------
500
501   ! 1. Declaration of the type of variable which have to be interpolated
502   !---------------------------------------------------------------------
503   CALL agrif_declare_var_lim2
504
505   ! 2. First interpolations of potentially non zero fields
506   !-------------------------------------------------------
507   Agrif_SpecialValue=-9999.
508   Agrif_UseSpecialValue = .TRUE.
509   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
510   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
511   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
512   Agrif_SpecialValue=0.
513   Agrif_UseSpecialValue = .FALSE.
514
515   ! 3. Some controls
516   !-----------------
517
518#   if ! defined key_lim2_vp
519   lim_nbstep = 1.
520   CALL agrif_rhg_lim2_load
521   CALL agrif_trp_lim2_load
522   lim_nbstep = 0.
523#   endif
524   !RB mandatory but why ???
525   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
526   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
527   !         nbclineupdate = nn_fsbc
528   !       ENDIF
529   CALL Agrif_Update_lim2(0)
530   !
531END SUBROUTINE Agrif_InitValues_cont_lim2
532
[7646]533
[3680]534SUBROUTINE agrif_declare_var_lim2
535   !!----------------------------------------------------------------------
536   !!                 *** ROUTINE agrif_declare_var_lim2 ***
537   !!
538   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
539   !!----------------------------------------------------------------------
540   USE agrif_util
541   USE ice_2
[7646]542   !!
[3680]543   IMPLICIT NONE
544   !!----------------------------------------------------------------------
545
546   ! 1. Declaration of the type of variable which have to be interpolated
547   !---------------------------------------------------------------------
548   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
549#   if defined key_lim2_vp
550   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
551   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
552#   else
553   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
554   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
555#   endif
556
557   ! 2. Type of interpolation
558   !-------------------------
559   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
[5656]560   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
561   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[3680]562
563   ! 3. Location of interpolation
564   !-----------------------------
[5656]565   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
566   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
567   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
[3680]568
569   ! 5. Update type
570   !---------------
[5656]571   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
572   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
573   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
574   !
[3680]575END SUBROUTINE agrif_declare_var_lim2
576#  endif
577
[7646]578#if defined key_lim3
579SUBROUTINE Agrif_InitValues_cont_lim3
580   !!----------------------------------------------------------------------
581   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
582   !!
583   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
584   !!----------------------------------------------------------------------
585   USE Agrif_Util
586   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
587   USE ice
588   USE agrif_ice
589   USE in_out_manager
590   USE agrif_lim3_update
591   USE agrif_lim3_interp
592   USE lib_mpp
593   !
594   IMPLICIT NONE
595   !!----------------------------------------------------------------------
596   !
597   ! Declaration of the type of variable which have to be interpolated (parent=>child)
598   !----------------------------------------------------------------------------------
599   CALL agrif_declare_var_lim3
[3680]600
[7761]601   ! Controls
602
603   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
604   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
605   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
606   !       If a solution is found, the following stop could be removed
607   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
608
[7646]609   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
610   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
611      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
612   ENDIF
613
614   ! stop if update frequency is different from nn_fsbc
615   IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc')
616
617
618   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
619   !----------------------------------------------------------------------
[7761]620!!   lim_nbstep = 1
621   lim_nbstep = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
[7646]622   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
623   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
624   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
625   lim_nbstep = 0
626   
627   ! Update in case 2 ways
628   !----------------------
629   CALL agrif_update_lim3(0)
630
631   !
632END SUBROUTINE Agrif_InitValues_cont_lim3
633
634SUBROUTINE agrif_declare_var_lim3
635   !!----------------------------------------------------------------------
636   !!                 *** ROUTINE agrif_declare_var_lim3 ***
637   !!
638   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
639   !!----------------------------------------------------------------------
640   USE Agrif_Util
641   USE ice
[8226]642   USE par_oce, ONLY : nbghostcells
643   !
[7646]644   IMPLICIT NONE
[8226]645   !
646   INTEGER :: ind1, ind2, ind3
[7646]647   !!----------------------------------------------------------------------
648   !
649   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
650   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
[7761]651   !           ex.:  position=> 1,1 = not-centered (in i and j)
652   !                            2,2 =     centered (    -     )
653   !                 index   => 1,1 = one ghost line
654   !                            2,2 = two ghost lines
[7646]655   !-------------------------------------------------------------------------------------
[8226]656   !!clem ghost
657   ind1 =     nbghostcells
658   ind2 = 1 + nbghostcells
659   ind3 = 2 + nbghostcells
660   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
661   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
662   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
663   !!clem ghost
[7646]664
665   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
666   !-----------------------------------
667   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
668   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
669   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
670
671   ! 3. Set location of interpolations
672   !----------------------------------
[8226]673   !!clem ghost
674   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
675   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
676   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
677   !!clem ghost
[7646]678
679   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
680   !--------------------------------------------------
[7761]681   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
[7646]682   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
683   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
684
685END SUBROUTINE agrif_declare_var_lim3
686#endif
687
688
[2715]689# if defined key_top
[3680]690SUBROUTINE Agrif_InitValues_cont_top
691   !!----------------------------------------------------------------------
692   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
693   !!
694   !! ** Purpose :: Declaration of variables to be interpolated
695   !!----------------------------------------------------------------------
696   USE Agrif_Util
697   USE oce 
698   USE dom_oce
699   USE nemogcm
700   USE par_trc
[5656]701   USE lib_mpp
[3680]702   USE trc
703   USE in_out_manager
[5656]704   USE agrif_opa_sponge
[3680]705   USE agrif_top_update
706   USE agrif_top_interp
707   USE agrif_top_sponge
[7646]708   !!
[3680]709   IMPLICIT NONE
710   !
[5656]711   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
[3680]712   LOGICAL :: check_namelist
713   !!----------------------------------------------------------------------
[1300]714
715
[3680]716   ! 1. Declaration of the type of variable which have to be interpolated
717   !---------------------------------------------------------------------
718   CALL agrif_declare_var_top
719
720   ! 2. First interpolations of potentially non zero fields
721   !-------------------------------------------------------
722   Agrif_SpecialValue=0.
723   Agrif_UseSpecialValue = .TRUE.
[5656]724   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
[3680]725   Agrif_UseSpecialValue = .FALSE.
[5656]726   CALL Agrif_Sponge
727   tabspongedone_trn = .FALSE.
728   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
729   ! reset tsa to zero
730   tra(:,:,:,:) = 0.
[3680]731
[5656]732
[3680]733   ! 3. Some controls
734   !-----------------
[5656]735   check_namelist = .TRUE.
[3680]736
737   IF( check_namelist ) THEN
738      ! Check time steps
[5656]739      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
740         WRITE(cl_check1,*)  Agrif_Parent(rdt)
741         WRITE(cl_check2,*)  rdt
742         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
[7646]743         CALL ctl_stop( 'incompatible time step between grids',   &
[5656]744               &               'parent grid value : '//cl_check1    ,   & 
745               &               'child  grid value : '//cl_check2    ,   & 
[7646]746               &               'value on child grid should be changed to  &
[5656]747               &               :'//cl_check3  )
[3680]748      ENDIF
749
750      ! Check run length
751      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[5656]752            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
753         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
754         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
755         CALL ctl_warn( 'incompatible run length between grids'               ,   &
756               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
757               &              ' nitend on fine grid will be change to : '//cl_check2    )
758         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
759         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
[3680]760      ENDIF
761
762      ! Check coordinates
763      IF( ln_zps ) THEN
764         ! check parameters for partial steps
[5656]765         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
[3680]766            WRITE(*,*) 'incompatible e3zps_min between grids'
767            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
768            WRITE(*,*) 'child grid  :',e3zps_min
769            WRITE(*,*) 'those values should be identical'
[1300]770            STOP
771         ENDIF
[5656]772         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
[3680]773            WRITE(*,*) 'incompatible e3zps_rat between grids'
774            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
775            WRITE(*,*) 'child grid  :',e3zps_rat
776            WRITE(*,*) 'those values should be identical'                 
[1300]777            STOP
778         ENDIF
[3680]779      ENDIF
780      ! Check passive tracer cell
[5656]781      IF( nn_dttrc .NE. 1 ) THEN
[3680]782         WRITE(*,*) 'nn_dttrc should be equal to 1'
[1300]783      ENDIF
[3680]784   ENDIF
[1300]785
[5656]786   CALL Agrif_Update_trc(0)
787   !
788   Agrif_UseSpecialValueInUpdate = .FALSE.
[3680]789   nbcline_trc = 0
790   !
791END SUBROUTINE Agrif_InitValues_cont_top
[2715]792
793
[3680]794SUBROUTINE agrif_declare_var_top
795   !!----------------------------------------------------------------------
796   !!                 *** ROUTINE agrif_declare_var_top ***
797   !!
798   !! ** Purpose :: Declaration of TOP variables to be interpolated
799   !!----------------------------------------------------------------------
800   USE agrif_util
[5656]801   USE agrif_oce
[3680]802   USE dom_oce
803   USE trc
[7646]804   !!
[3680]805   IMPLICIT NONE
[8226]806   !
807   INTEGER :: ind1, ind2, ind3
[7646]808   !!----------------------------------------------------------------------
[2715]809
[3680]810   ! 1. Declaration of the type of variable which have to be interpolated
811   !---------------------------------------------------------------------
[8226]812   !!clem ghost
813   ind1 =     nbghostcells
814   ind2 = 1 + nbghostcells
815   ind3 = 2 + nbghostcells
816   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)
817   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)
[2715]818
[3680]819   ! 2. Type of interpolation
820   !-------------------------
821   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
[5656]822   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
[3680]823
824   ! 3. Location of interpolation
825   !-----------------------------
[8226]826   !!clem ghost
827   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
828   !clem: previously set to /-,0/
[5656]829   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
[3680]830
831   ! 5. Update type
832   !---------------
[5656]833   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
[3680]834
[5656]835!   Higher order update
836!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
[3680]837
[5656]838   !
[3680]839END SUBROUTINE agrif_declare_var_top
[2715]840# endif
[636]841
[3680]842SUBROUTINE Agrif_detect( kg, ksizex )
843   !!----------------------------------------------------------------------
[7646]844   !!                      *** ROUTINE Agrif_detect ***
[3680]845   !!----------------------------------------------------------------------
846   INTEGER, DIMENSION(2) :: ksizex
847   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
848   !!----------------------------------------------------------------------
849   !
850   RETURN
851   !
852END SUBROUTINE Agrif_detect
[390]853
[782]854
[3680]855SUBROUTINE agrif_nemo_init
856   !!----------------------------------------------------------------------
857   !!                     *** ROUTINE agrif_init ***
858   !!----------------------------------------------------------------------
859   USE agrif_oce 
860   USE agrif_ice
861   USE in_out_manager
862   USE lib_mpp
[7646]863   !!
[3680]864   IMPLICIT NONE
865   !
[4147]866   INTEGER  ::   ios                 ! Local integer output status for namelist read
[5656]867   INTEGER  ::   iminspon
868   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
869   !!--------------------------------------------------------------------------------------
[3680]870   !
[5656]871   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
872   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
873901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
[4147]874
[5656]875   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
876   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
877902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
878   IF(lwm) WRITE ( numond, namagrif )
[3680]879   !
880   IF(lwp) THEN                    ! control print
881      WRITE(numout,*)
882      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
883      WRITE(numout,*) '~~~~~~~~~~~~~~~'
884      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
885      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
886      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
887      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
888      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
[5656]889      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
[3680]890      WRITE(numout,*) 
891   ENDIF
892   !
893   ! convert DOCTOR namelist name into OLD names
894   nbclineupdate = nn_cln_update
895   visc_tra      = rn_sponge_tra
896   visc_dyn      = rn_sponge_dyn
897   !
[5656]898   ! Check sponge length:
899   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
900   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
901   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
902   !
903   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
[3680]904# if defined key_lim2
[7646]905   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3)
[3680]906# endif
907   !
908END SUBROUTINE agrif_nemo_init
909
[1605]910# if defined key_mpp_mpi
911
[3680]912SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
913   !!----------------------------------------------------------------------
914   !!                     *** ROUTINE Agrif_detect ***
915   !!----------------------------------------------------------------------
916   USE dom_oce
[7646]917   !!
[3680]918   IMPLICIT NONE
919   !
920   INTEGER :: indglob, indloc, nprocloc, i
921   !!----------------------------------------------------------------------
922   !
923   SELECT CASE( i )
924   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
[5656]925   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
926   CASE DEFAULT
927      indglob = indloc
[3680]928   END SELECT
929   !
930END SUBROUTINE Agrif_InvLoc
[390]931
[7646]932
[5656]933SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
934   !!----------------------------------------------------------------------
935   !!                 *** ROUTINE Agrif_get_proc_info ***
936   !!----------------------------------------------------------------------
937   USE par_oce
[7646]938   !!
[5656]939   IMPLICIT NONE
940   !
941   INTEGER, INTENT(out) :: imin, imax
942   INTEGER, INTENT(out) :: jmin, jmax
943   !!----------------------------------------------------------------------
944   !
945   imin = nimppt(Agrif_Procrank+1)  ! ?????
946   jmin = njmppt(Agrif_Procrank+1)  ! ?????
947   imax = imin + jpi - 1
948   jmax = jmin + jpj - 1
949   !
950END SUBROUTINE Agrif_get_proc_info
951
[7646]952
[5656]953SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
954   !!----------------------------------------------------------------------
955   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
956   !!----------------------------------------------------------------------
957   USE par_oce
[7646]958   !!
[5656]959   IMPLICIT NONE
960   !
961   INTEGER,  INTENT(in)  :: imin, imax
962   INTEGER,  INTENT(in)  :: jmin, jmax
963   INTEGER,  INTENT(in)  :: nbprocs
964   REAL(wp), INTENT(out) :: grid_cost
965   !!----------------------------------------------------------------------
966   !
967   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
968   !
969END SUBROUTINE Agrif_estimate_parallel_cost
970
[1605]971# endif
972
[390]973#else
[3680]974SUBROUTINE Subcalledbyagrif
975   !!----------------------------------------------------------------------
976   !!                   *** ROUTINE Subcalledbyagrif ***
977   !!----------------------------------------------------------------------
978   WRITE(*,*) 'Impossible to be here'
979END SUBROUTINE Subcalledbyagrif
[390]980#endif
Note: See TracBrowser for help on using the repository browser.