source: trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 5573

Last change on this file since 5573 was 5573, checked in by rblod, 5 years ago

Fix ticket #1573 for the trunk

  • Property svn:keywords set to Id
File size: 24.9 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      jpk     = jpkdta 
33      jpim1   = jpi-1 
34      jpjm1   = jpj-1 
35      jpkm1   = jpk-1                                         
36      jpij    = jpi*jpj 
37      jpidta  = jpiglo
38      jpjdta  = jpjglo
39      jpizoom = 1
40      jpjzoom = 1
41      nperio  = 0
42      jperio  = 0
43   ENDIF
44   !
45END SUBROUTINE Agrif_InitWorkspace
46
47
48SUBROUTINE Agrif_InitValues
49   !!----------------------------------------------------------------------
50   !!                 *** ROUTINE Agrif_InitValues ***
51   !!
52   !! ** Purpose :: Declaration of variables to be interpolated
53   !!----------------------------------------------------------------------
54   USE Agrif_Util
55   USE oce 
56   USE dom_oce
57   USE nemogcm
58   USE tradmp
59   USE bdy_par
60
61   IMPLICIT NONE
62   !!----------------------------------------------------------------------
63   ! 0. Initializations
64   !-------------------
65   IF( cp_cfg == 'orca' ) then
66      IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
67  &                      .OR. jp_cfg == 4 ) THEN
68         jp_cfg = -1    ! set special value for jp_cfg on fine grids
69         cp_cfg = "default"
70      ENDIF
71   ENDIF
72   ! Specific fine grid Initializations
73   ! no tracer damping on fine grids
74   ln_tradmp = .FALSE.
75   ! no open boundary on fine grids
76   lk_bdy = .FALSE.
77
78
79   CALL nemo_init  ! Initializations of each fine grid
80
81   CALL agrif_nemo_init
82   CALL Agrif_InitValues_cont_dom
83# if ! defined key_offline
84   CALL Agrif_InitValues_cont
85# endif       
86# if defined key_top
87   CALL Agrif_InitValues_cont_top
88# endif     
89END SUBROUTINE Agrif_initvalues
90
91
92SUBROUTINE Agrif_InitValues_cont_dom
93   !!----------------------------------------------------------------------
94   !!                 *** ROUTINE Agrif_InitValues_cont ***
95   !!
96   !! ** Purpose ::   Declaration of variables to be interpolated
97   !!----------------------------------------------------------------------
98   USE Agrif_Util
99   USE oce 
100   USE dom_oce
101   USE nemogcm
102   USE sol_oce
103   USE in_out_manager
104   USE agrif_opa_update
105   USE agrif_opa_interp
106   USE agrif_opa_sponge
107   !
108   IMPLICIT NONE
109   !
110   !!----------------------------------------------------------------------
111
112   ! Declaration of the type of variable which have to be interpolated
113   !---------------------------------------------------------------------
114   CALL agrif_declare_var_dom
115   !
116END SUBROUTINE Agrif_InitValues_cont_dom
117
118
119SUBROUTINE agrif_declare_var_dom
120   !!----------------------------------------------------------------------
121   !!                 *** ROUTINE agrif_declarE_var ***
122   !!
123   !! ** Purpose :: Declaration of variables to be interpolated
124   !!----------------------------------------------------------------------
125   USE agrif_util
126   USE par_oce       !   ONLY : jpts
127   USE oce
128   IMPLICIT NONE
129   !!----------------------------------------------------------------------
130
131   ! 1. Declaration of the type of variable which have to be interpolated
132   !---------------------------------------------------------------------
133   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
134   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
135
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
152END SUBROUTINE agrif_declare_var_dom
153
154
155# if ! defined key_offline
156
157SUBROUTINE Agrif_InitValues_cont
158   !!----------------------------------------------------------------------
159   !!                 *** ROUTINE Agrif_InitValues_cont ***
160   !!
161   !! ** Purpose ::   Declaration of variables to be interpolated
162   !!----------------------------------------------------------------------
163   USE Agrif_Util
164   USE oce 
165   USE dom_oce
166   USE nemogcm
167   USE sol_oce
168   USE in_out_manager
169   USE agrif_opa_update
170   USE agrif_opa_interp
171   USE agrif_opa_sponge
172   !
173   IMPLICIT NONE
174   !
175   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
176   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
177   REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d
178   LOGICAL :: check_namelist
179   !!----------------------------------------------------------------------
180
181   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
182   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
183   ALLOCATE( tab2d(jpi, jpj)                )
184
185
186   ! 1. Declaration of the type of variable which have to be interpolated
187   !---------------------------------------------------------------------
188   CALL agrif_declare_var
189
190   ! 2. First interpolations of potentially non zero fields
191   !-------------------------------------------------------
192   Agrif_SpecialValue=0.
193   Agrif_UseSpecialValue = .TRUE.
194   Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
195   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
196
197   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
198   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
199   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
200   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
201
202   Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb)
203   Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb)
204   Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn)
205   Agrif_UseSpecialValue = .FALSE.
206
207   ! 3. Some controls
208   !-----------------
209   check_namelist = .true.
210
211   IF( check_namelist ) THEN
212
213      ! Check time steps           
214      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
215         WRITE(*,*) 'incompatible time step between grids'
216         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
217         WRITE(*,*) 'child  grid value : ',nint(rdt)
218         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
219         STOP
220      ENDIF
221
222      ! Check run length
223      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
224           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
225         WRITE(*,*) 'incompatible run length between grids'
226         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
227              Agrif_Parent(nit000)+1),' time step'
228         WRITE(*,*) 'child  grid value : ', &
229              (nitend-nit000+1),' time step'
230         WRITE(*,*) 'value on child grid should be : ', &
231              Agrif_IRhot() * (Agrif_Parent(nitend)- &
232              Agrif_Parent(nit000)+1)
233         STOP
234      ENDIF
235
236      ! Check coordinates
237      IF( ln_zps ) THEN
238         ! check parameters for partial steps
239         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
240            WRITE(*,*) 'incompatible e3zps_min between grids'
241            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
242            WRITE(*,*) 'child grid  :',e3zps_min
243            WRITE(*,*) 'those values should be identical'
244            STOP
245         ENDIF
246         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
247            WRITE(*,*) 'incompatible e3zps_rat between grids'
248            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
249            WRITE(*,*) 'child grid  :',e3zps_rat
250            WRITE(*,*) 'those values should be identical'                 
251            STOP
252         ENDIF
253      ENDIF
254   ENDIF
255
256   CALL Agrif_Update_tra(0)
257   CALL Agrif_Update_dyn(0)
258
259   nbcline = 0
260   !
261   DEALLOCATE(tabtstemp)
262   DEALLOCATE(tabuvtemp)
263   DEALLOCATE(tab2d)
264   !
265END SUBROUTINE Agrif_InitValues_cont
266
267
268SUBROUTINE agrif_declare_var
269   !!----------------------------------------------------------------------
270   !!                 *** ROUTINE agrif_declarE_var ***
271   !!
272   !! ** Purpose :: Declaration of variables to be interpolated
273   !!----------------------------------------------------------------------
274   USE agrif_util
275   USE par_oce       !   ONLY : jpts
276   USE oce
277   IMPLICIT NONE
278   !!----------------------------------------------------------------------
279
280   ! 1. Declaration of the type of variable which have to be interpolated
281   !---------------------------------------------------------------------
282   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
283   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id)
284   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id)
285
286   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
287   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
288   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
289   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
290
291   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
292   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
293   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
294   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
295   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id)
296   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id)
297
298   ! 2. Type of interpolation
299   !-------------------------
300   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
301   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
302
303   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
304   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
305
306   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
307   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
308
309   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
310   Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
311   Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
312   Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
313   Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
314
315   ! 3. Location of interpolation
316   !-----------------------------
317   Call Agrif_Set_bc(un_id,(/0,1/))
318   Call Agrif_Set_bc(vn_id,(/0,1/))
319
320   Call Agrif_Set_bc(sshn_id,(/0,1/))
321   Call Agrif_Set_bc(unb_id,(/0,1/))
322   Call Agrif_Set_bc(vnb_id,(/0,1/))
323   Call Agrif_Set_bc(ub2b_id,(/0,1/))
324   Call Agrif_Set_bc(vb2b_id,(/0,1/))
325
326   Call Agrif_Set_bc(tsn_id,(/0,1/))
327   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
328
329   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
330   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
331
332   ! 5. Update type
333   !---------------
334   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
335   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
336
337   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
338   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
339
340   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
341   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
342
343   Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
344   Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
345
346END SUBROUTINE agrif_declare_var
347# endif
348
349#  if defined key_lim2
350SUBROUTINE Agrif_InitValues_cont_lim2
351   !!----------------------------------------------------------------------
352   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
353   !!
354   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
355   !!----------------------------------------------------------------------
356   USE Agrif_Util
357   USE ice_2
358   USE agrif_ice
359   USE in_out_manager
360   USE agrif_lim2_update
361   USE agrif_lim2_interp
362   USE lib_mpp
363   !
364   IMPLICIT NONE
365   !
366   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
367   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv
368   !!----------------------------------------------------------------------
369
370   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7))
371
372   ! 1. Declaration of the type of variable which have to be interpolated
373   !---------------------------------------------------------------------
374   CALL agrif_declare_var_lim2
375
376   ! 2. First interpolations of potentially non zero fields
377   !-------------------------------------------------------
378   Agrif_SpecialValue=-9999.
379   Agrif_UseSpecialValue = .TRUE.
380   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
381   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
382   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
383   Agrif_SpecialValue=0.
384   Agrif_UseSpecialValue = .FALSE.
385
386   ! 3. Some controls
387   !-----------------
388
389#   if ! defined key_lim2_vp
390   lim_nbstep = 1.
391   CALL agrif_rhg_lim2_load
392   CALL agrif_trp_lim2_load
393   lim_nbstep = 0.
394#   endif
395   !RB mandatory but why ???
396   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
397   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
398   !         nbclineupdate = nn_fsbc
399   !       ENDIF
400   CALL Agrif_Update_lim2(0)
401   !
402   DEALLOCATE( zvel, zadv )
403   !
404END SUBROUTINE Agrif_InitValues_cont_lim2
405
406SUBROUTINE agrif_declare_var_lim2
407   !!----------------------------------------------------------------------
408   !!                 *** ROUTINE agrif_declare_var_lim2 ***
409   !!
410   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
411   !!----------------------------------------------------------------------
412   USE agrif_util
413   USE ice_2
414
415   IMPLICIT NONE
416   !!----------------------------------------------------------------------
417
418   ! 1. Declaration of the type of variable which have to be interpolated
419   !---------------------------------------------------------------------
420   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
421#   if defined key_lim2_vp
422   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
423   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
424#   else
425   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
426   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
427#   endif
428
429   ! 2. Type of interpolation
430   !-------------------------
431   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
432   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
433   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
434
435   ! 3. Location of interpolation
436   !-----------------------------
437   Call Agrif_Set_bc(adv_ice_id ,(/0,1/))
438   Call Agrif_Set_bc(u_ice_id,(/0,1/))
439   Call Agrif_Set_bc(v_ice_id,(/0,1/))
440
441   ! 5. Update type
442   !---------------
443   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
444   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
445   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
446
447END SUBROUTINE agrif_declare_var_lim2
448#  endif
449
450
451# if defined key_top
452SUBROUTINE Agrif_InitValues_cont_top
453   !!----------------------------------------------------------------------
454   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
455   !!
456   !! ** Purpose :: Declaration of variables to be interpolated
457   !!----------------------------------------------------------------------
458   USE Agrif_Util
459   USE oce 
460   USE dom_oce
461   USE nemogcm
462   USE par_trc
463   USE trc
464   USE in_out_manager
465   USE agrif_top_update
466   USE agrif_top_interp
467   USE agrif_top_sponge
468   !
469   IMPLICIT NONE
470   !
471   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
472   LOGICAL :: check_namelist
473   !!----------------------------------------------------------------------
474
475   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
476
477
478   ! 1. Declaration of the type of variable which have to be interpolated
479   !---------------------------------------------------------------------
480   CALL agrif_declare_var_top
481
482   ! 2. First interpolations of potentially non zero fields
483   !-------------------------------------------------------
484   Agrif_SpecialValue=0.
485   Agrif_UseSpecialValue = .TRUE.
486   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
487   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
488   Agrif_UseSpecialValue = .FALSE.
489
490   ! 3. Some controls
491   !-----------------
492   check_namelist = .true.
493
494   IF( check_namelist ) THEN
495#  if defined offline     
496      ! Check time steps
497      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
498         WRITE(*,*) 'incompatible time step between grids'
499         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
500         WRITE(*,*) 'child  grid value : ',nint(rdt)
501         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
502         STOP
503      ENDIF
504
505      ! Check run length
506      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
507           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
508         WRITE(*,*) 'incompatible run length between grids'
509         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
510              Agrif_Parent(nit000)+1),' time step'
511         WRITE(*,*) 'child  grid value : ', &
512              (nitend-nit000+1),' time step'
513         WRITE(*,*) 'value on child grid should be : ', &
514              Agrif_IRhot() * (Agrif_Parent(nitend)- &
515              Agrif_Parent(nit000)+1)
516         STOP
517      ENDIF
518
519      ! Check coordinates
520      IF( ln_zps ) THEN
521         ! check parameters for partial steps
522         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
523            WRITE(*,*) 'incompatible e3zps_min between grids'
524            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
525            WRITE(*,*) 'child grid  :',e3zps_min
526            WRITE(*,*) 'those values should be identical'
527            STOP
528         ENDIF
529         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
530            WRITE(*,*) 'incompatible e3zps_rat between grids'
531            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
532            WRITE(*,*) 'child grid  :',e3zps_rat
533            WRITE(*,*) 'those values should be identical'                 
534            STOP
535         ENDIF
536      ENDIF
537#  endif         
538      ! Check passive tracer cell
539      IF( nn_dttrc .ne. 1 ) THEN
540         WRITE(*,*) 'nn_dttrc should be equal to 1'
541      ENDIF
542   ENDIF
543
544!ch   CALL Agrif_Update_trc(0)
545   nbcline_trc = 0
546   !
547   DEALLOCATE(tabtrtemp)
548   !
549END SUBROUTINE Agrif_InitValues_cont_top
550
551
552SUBROUTINE agrif_declare_var_top
553   !!----------------------------------------------------------------------
554   !!                 *** ROUTINE agrif_declare_var_top ***
555   !!
556   !! ** Purpose :: Declaration of TOP variables to be interpolated
557   !!----------------------------------------------------------------------
558   USE agrif_util
559   USE dom_oce
560   USE trc
561
562   IMPLICIT NONE
563
564   ! 1. Declaration of the type of variable which have to be interpolated
565   !---------------------------------------------------------------------
566   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
567   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
568   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id)
569
570   ! 2. Type of interpolation
571   !-------------------------
572   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
573   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
574
575   ! 3. Location of interpolation
576   !-----------------------------
577   Call Agrif_Set_bc(trn_id,(/0,1/))
578   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
579
580   ! 5. Update type
581   !---------------
582   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
583   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
584
585
586END SUBROUTINE agrif_declare_var_top
587# endif
588
589SUBROUTINE Agrif_detect( kg, ksizex )
590   !!----------------------------------------------------------------------
591   !!   *** ROUTINE Agrif_detect ***
592   !!----------------------------------------------------------------------
593   USE Agrif_Types
594   !
595   INTEGER, DIMENSION(2) :: ksizex
596   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
597   !!----------------------------------------------------------------------
598   !
599   RETURN
600   !
601END SUBROUTINE Agrif_detect
602
603
604SUBROUTINE agrif_nemo_init
605   !!----------------------------------------------------------------------
606   !!                     *** ROUTINE agrif_init ***
607   !!----------------------------------------------------------------------
608   USE agrif_oce 
609   USE agrif_ice
610   USE in_out_manager
611   USE lib_mpp
612   IMPLICIT NONE
613   !
614   INTEGER  ::   ios                 ! Local integer output status for namelist read
615   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
616   !!----------------------------------------------------------------------
617   !
618      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
619      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
620901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
621
622      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
623      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
624902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
625      IF(lwm) WRITE ( numond, namagrif )
626   !
627   IF(lwp) THEN                    ! control print
628      WRITE(numout,*)
629      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
630      WRITE(numout,*) '~~~~~~~~~~~~~~~'
631      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
632      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
633      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
634      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
635      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
636      WRITE(numout,*) 
637   ENDIF
638   !
639   ! convert DOCTOR namelist name into OLD names
640   nbclineupdate = nn_cln_update
641   visc_tra      = rn_sponge_tra
642   visc_dyn      = rn_sponge_dyn
643   !
644   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
645# if defined key_lim2
646   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
647# endif
648   !
649END SUBROUTINE agrif_nemo_init
650
651# if defined key_mpp_mpi
652
653SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
654   !!----------------------------------------------------------------------
655   !!                     *** ROUTINE Agrif_detect ***
656   !!----------------------------------------------------------------------
657   USE dom_oce
658   IMPLICIT NONE
659   !
660   INTEGER :: indglob, indloc, nprocloc, i
661   !!----------------------------------------------------------------------
662   !
663   SELECT CASE( i )
664   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
665   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
666   CASE(3)   ;   indglob = indloc
667   CASE(4)   ;   indglob = indloc
668   END SELECT
669   !
670END SUBROUTINE Agrif_InvLoc
671
672# endif
673
674#else
675SUBROUTINE Subcalledbyagrif
676   !!----------------------------------------------------------------------
677   !!                   *** ROUTINE Subcalledbyagrif ***
678   !!----------------------------------------------------------------------
679   WRITE(*,*) 'Impossible to be here'
680END SUBROUTINE Subcalledbyagrif
681#endif
Note: See TracBrowser for help on using the repository browser.