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

source: branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 6584

Last change on this file since 6584 was 6584, checked in by clem, 8 years ago

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