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/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 2804

Last change on this file since 2804 was 2804, checked in by rblod, 13 years ago

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