source: branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4018

Last change on this file since 4018 was 4018, checked in by clevy, 8 years ago

Configuration setting, bugfixes for AGRIF, see ticket:#1074

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