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_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8010

Last change on this file since 8010 was 8010, checked in by jchanut, 7 years ago

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