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/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4326

Last change on this file since 4326 was 4326, checked in by cbricaud, 10 years ago

Missing variables definition for time splitting, see ticket #1196

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