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/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 6596

Last change on this file since 6596 was 6596, checked in by gm, 8 years ago

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