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

source: branches/2012/dev_LOCEAN_2012/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 3584

Last change on this file since 3584 was 3584, checked in by cetlod, 11 years ago

Add in branch 2012/dev_LOCEAN_2012 changes from dev_r3438_LOCEAN15_PISLOB & dev_r3387_LOCEAN6_AGRIF_LIM, see ticket 1000

  • Property svn:keywords set to Id
File size: 23.0 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 obc_par
61   USE bdy_par
62
63   IMPLICIT NONE
64   !!----------------------------------------------------------------------
65
66   ! 0. Initializations
67   !-------------------
68#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
69   jp_cfg = -1    ! set special value for jp_cfg on fine grids
70   cp_cfg = "default"
71#endif
72
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_obc = .FALSE.
78   lk_bdy = .FALSE.
79
80   CALL nemo_init  ! Initializations of each fine grid
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   LOGICAL :: check_namelist
178   !!----------------------------------------------------------------------
179
180   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
181   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
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(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
193   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
194
195   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
196   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
197   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
198   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
199   Agrif_UseSpecialValue = .FALSE.
200
201   ! 3. Some controls
202   !-----------------
203   check_namelist = .true.
204
205   IF( check_namelist ) THEN
206
207      ! Check time steps           
208      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
209         WRITE(*,*) 'incompatible time step between grids'
210         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
211         WRITE(*,*) 'child  grid value : ',nint(rdt)
212         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
213         STOP
214      ENDIF
215
216      ! Check run length
217      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
218           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
219         WRITE(*,*) 'incompatible run length between grids'
220         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
221              Agrif_Parent(nit000)+1),' time step'
222         WRITE(*,*) 'child  grid value : ', &
223              (nitend-nit000+1),' time step'
224         WRITE(*,*) 'value on child grid should be : ', &
225              Agrif_IRhot() * (Agrif_Parent(nitend)- &
226              Agrif_Parent(nit000)+1)
227         STOP
228      ENDIF
229
230      ! Check coordinates
231      IF( ln_zps ) THEN
232         ! check parameters for partial steps
233         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
234            WRITE(*,*) 'incompatible e3zps_min between grids'
235            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
236            WRITE(*,*) 'child grid  :',e3zps_min
237            WRITE(*,*) 'those values should be identical'
238            STOP
239         ENDIF
240         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
241            WRITE(*,*) 'incompatible e3zps_rat between grids'
242            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
243            WRITE(*,*) 'child grid  :',e3zps_rat
244            WRITE(*,*) 'those values should be identical'                 
245            STOP
246         ENDIF
247      ENDIF
248   ENDIF
249
250   CALL Agrif_Update_tra(0)
251   CALL Agrif_Update_dyn(0)
252
253   nbcline = 0
254   !
255   DEALLOCATE(tabtstemp)
256   DEALLOCATE(tabuvtemp)
257   !
258END SUBROUTINE Agrif_InitValues_cont
259
260
261SUBROUTINE agrif_declare_var
262   !!----------------------------------------------------------------------
263   !!                 *** ROUTINE agrif_declarE_var ***
264   !!
265   !! ** Purpose :: Declaration of variables to be interpolated
266   !!----------------------------------------------------------------------
267   USE agrif_util
268   USE par_oce       !   ONLY : jpts
269   USE oce
270   IMPLICIT NONE
271   !!----------------------------------------------------------------------
272
273   ! 1. Declaration of the type of variable which have to be interpolated
274   !---------------------------------------------------------------------
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/),tsn_id)
276   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)
277   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)
278
279   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
280   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
281   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
282   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
283
284   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
285   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
286
287   ! 2. Type of interpolation
288   !-------------------------
289   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
290   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
291
292   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
293   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
294
295   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
296   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
297
298   ! 3. Location of interpolation
299   !-----------------------------
300   Call Agrif_Set_bc(un_id,(/0,1/))
301   Call Agrif_Set_bc(vn_id,(/0,1/))
302
303   Call Agrif_Set_bc(tsn_id,(/0,1/))
304   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
305
306   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
307   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
308
309   ! 5. Update type
310   !---------------
311   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
312   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
313
314   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
315   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
316
317   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
318   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
319
320END SUBROUTINE agrif_declare_var
321# endif
322
323#  if defined key_lim2
324SUBROUTINE Agrif_InitValues_cont_lim2
325   !!----------------------------------------------------------------------
326   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
327   !!
328   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
329   !!----------------------------------------------------------------------
330   USE Agrif_Util
331   USE ice_2
332   USE agrif_ice
333   USE in_out_manager
334   USE agrif_lim2_update
335   USE agrif_lim2_interp
336   USE lib_mpp
337   !
338   IMPLICIT NONE
339   !
340   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
341   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv
342   !!----------------------------------------------------------------------
343
344   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7))
345
346   ! 1. Declaration of the type of variable which have to be interpolated
347   !---------------------------------------------------------------------
348   CALL agrif_declare_var_lim2
349
350   ! 2. First interpolations of potentially non zero fields
351   !-------------------------------------------------------
352   Agrif_SpecialValue=-9999.
353   Agrif_UseSpecialValue = .TRUE.
354   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
355   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
356   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
357   Agrif_SpecialValue=0.
358   Agrif_UseSpecialValue = .FALSE.
359
360   ! 3. Some controls
361   !-----------------
362
363#   if ! defined key_lim2_vp
364   lim_nbstep = 1.
365   CALL agrif_rhg_lim2_load
366   CALL agrif_trp_lim2_load
367   lim_nbstep = 0.
368#   endif
369   !RB mandatory but why ???
370   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
371   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
372   !         nbclineupdate = nn_fsbc
373   !       ENDIF
374   CALL Agrif_Update_lim2(0)
375   !
376   DEALLOCATE( zvel, zadv )
377   !
378END SUBROUTINE Agrif_InitValues_cont_lim2
379
380SUBROUTINE agrif_declare_var_lim2
381   !!----------------------------------------------------------------------
382   !!                 *** ROUTINE agrif_declare_var_lim2 ***
383   !!
384   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
385   !!----------------------------------------------------------------------
386   USE agrif_util
387   USE ice_2
388
389   IMPLICIT NONE
390   !!----------------------------------------------------------------------
391
392   ! 1. Declaration of the type of variable which have to be interpolated
393   !---------------------------------------------------------------------
394   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
395#   if defined key_lim2_vp
396   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
397   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
398#   else
399   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
400   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
401#   endif
402
403   ! 2. Type of interpolation
404   !-------------------------
405   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
406   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
407   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
408
409   ! 3. Location of interpolation
410   !-----------------------------
411   Call Agrif_Set_bc(adv_ice_id ,(/0,1/))
412   Call Agrif_Set_bc(u_ice_id,(/0,1/))
413   Call Agrif_Set_bc(v_ice_id,(/0,1/))
414
415   ! 5. Update type
416   !---------------
417   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
418   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
419   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
420
421END SUBROUTINE agrif_declare_var_lim2
422#  endif
423
424
425# if defined key_top
426SUBROUTINE Agrif_InitValues_cont_top
427   !!----------------------------------------------------------------------
428   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
429   !!
430   !! ** Purpose :: Declaration of variables to be interpolated
431   !!----------------------------------------------------------------------
432   USE Agrif_Util
433   USE oce 
434   USE dom_oce
435   USE nemogcm
436   USE par_trc
437   USE trc
438   USE in_out_manager
439   USE agrif_top_update
440   USE agrif_top_interp
441   USE agrif_top_sponge
442   !
443   IMPLICIT NONE
444   !
445   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
446   LOGICAL :: check_namelist
447   !!----------------------------------------------------------------------
448
449   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
450
451
452   ! 1. Declaration of the type of variable which have to be interpolated
453   !---------------------------------------------------------------------
454   CALL agrif_declare_var_top
455
456   ! 2. First interpolations of potentially non zero fields
457   !-------------------------------------------------------
458   Agrif_SpecialValue=0.
459   Agrif_UseSpecialValue = .TRUE.
460   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
461   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
462   Agrif_UseSpecialValue = .FALSE.
463
464   ! 3. Some controls
465   !-----------------
466   check_namelist = .true.
467
468   IF( check_namelist ) THEN
469#  if defined offline     
470      ! Check time steps
471      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
472         WRITE(*,*) 'incompatible time step between grids'
473         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
474         WRITE(*,*) 'child  grid value : ',nint(rdt)
475         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
476         STOP
477      ENDIF
478
479      ! Check run length
480      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
481           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
482         WRITE(*,*) 'incompatible run length between grids'
483         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
484              Agrif_Parent(nit000)+1),' time step'
485         WRITE(*,*) 'child  grid value : ', &
486              (nitend-nit000+1),' time step'
487         WRITE(*,*) 'value on child grid should be : ', &
488              Agrif_IRhot() * (Agrif_Parent(nitend)- &
489              Agrif_Parent(nit000)+1)
490         STOP
491      ENDIF
492
493      ! Check coordinates
494      IF( ln_zps ) THEN
495         ! check parameters for partial steps
496         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
497            WRITE(*,*) 'incompatible e3zps_min between grids'
498            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
499            WRITE(*,*) 'child grid  :',e3zps_min
500            WRITE(*,*) 'those values should be identical'
501            STOP
502         ENDIF
503         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
504            WRITE(*,*) 'incompatible e3zps_rat between grids'
505            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
506            WRITE(*,*) 'child grid  :',e3zps_rat
507            WRITE(*,*) 'those values should be identical'                 
508            STOP
509         ENDIF
510      ENDIF
511#  endif         
512      ! Check passive tracer cell
513      IF( nn_dttrc .ne. 1 ) THEN
514         WRITE(*,*) 'nn_dttrc should be equal to 1'
515      ENDIF
516   ENDIF
517
518!ch   CALL Agrif_Update_trc(0)
519   nbcline_trc = 0
520   !
521   DEALLOCATE(tabtrtemp)
522   !
523END SUBROUTINE Agrif_InitValues_cont_top
524
525
526SUBROUTINE agrif_declare_var_top
527   !!----------------------------------------------------------------------
528   !!                 *** ROUTINE agrif_declare_var_top ***
529   !!
530   !! ** Purpose :: Declaration of TOP variables to be interpolated
531   !!----------------------------------------------------------------------
532   USE agrif_util
533   USE dom_oce
534   USE trc
535
536   IMPLICIT NONE
537
538   ! 1. Declaration of the type of variable which have to be interpolated
539   !---------------------------------------------------------------------
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/),trn_id)
541   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)
542   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)
543
544   ! 2. Type of interpolation
545   !-------------------------
546   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
547   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
548
549   ! 3. Location of interpolation
550   !-----------------------------
551   Call Agrif_Set_bc(trn_id,(/0,1/))
552   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
553
554   ! 5. Update type
555   !---------------
556   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
557   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
558
559
560END SUBROUTINE agrif_declare_var_top
561# endif
562
563SUBROUTINE Agrif_detect( kg, ksizex )
564   !!----------------------------------------------------------------------
565   !!   *** ROUTINE Agrif_detect ***
566   !!----------------------------------------------------------------------
567   USE Agrif_Types
568   !
569   INTEGER, DIMENSION(2) :: ksizex
570   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
571   !!----------------------------------------------------------------------
572   !
573   RETURN
574   !
575END SUBROUTINE Agrif_detect
576
577
578SUBROUTINE agrif_nemo_init
579   !!----------------------------------------------------------------------
580   !!                     *** ROUTINE agrif_init ***
581   !!----------------------------------------------------------------------
582   USE agrif_oce 
583   USE agrif_ice
584   USE in_out_manager
585   USE lib_mpp
586   IMPLICIT NONE
587   !
588   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
589   !!----------------------------------------------------------------------
590   !
591   REWIND( numnam )                ! Read namagrif namelist
592   READ  ( numnam, namagrif )
593   !
594   IF(lwp) THEN                    ! control print
595      WRITE(numout,*)
596      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
597      WRITE(numout,*) '~~~~~~~~~~~~~~~'
598      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
599      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
600      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
601      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
602      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
603      WRITE(numout,*) 
604   ENDIF
605   !
606   ! convert DOCTOR namelist name into OLD names
607   nbclineupdate = nn_cln_update
608   visc_tra      = rn_sponge_tra
609   visc_dyn      = rn_sponge_dyn
610   !
611   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
612# if defined key_lim2
613   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
614# endif
615   !
616END SUBROUTINE agrif_nemo_init
617
618# if defined key_mpp_mpi
619
620SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
621   !!----------------------------------------------------------------------
622   !!                     *** ROUTINE Agrif_detect ***
623   !!----------------------------------------------------------------------
624   USE dom_oce
625   IMPLICIT NONE
626   !
627   INTEGER :: indglob, indloc, nprocloc, i
628   !!----------------------------------------------------------------------
629   !
630   SELECT CASE( i )
631   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
632   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
633   CASE(3)   ;   indglob = indloc
634   CASE(4)   ;   indglob = indloc
635   END SELECT
636   !
637END SUBROUTINE Agrif_InvLoc
638
639# endif
640
641#else
642SUBROUTINE Subcalledbyagrif
643   !!----------------------------------------------------------------------
644   !!                   *** ROUTINE Subcalledbyagrif ***
645   !!----------------------------------------------------------------------
646   WRITE(*,*) 'Impossible to be here'
647END SUBROUTINE Subcalledbyagrif
648#endif
Note: See TracBrowser for help on using the repository browser.