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

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4861

Last change on this file since 4861 was 4793, checked in by rblod, 10 years ago

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