source: NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90 @ 11827

Last change on this file since 11827 was 11827, checked in by jchanut, 11 months ago

#2222, corrections to interpolation within sponge

  • Property svn:keywords set to Id
File size: 36.7 KB
Line 
1#undef UPD_HIGH   /* MIX HIGH UPDATE */
2#if defined key_agrif
3   !!----------------------------------------------------------------------
4   !! NEMO/NST 4.0 , NEMO Consortium (2018)
5   !! $Id$
6   !! Software governed by the CeCILL license (see ./LICENSE)
7   !!----------------------------------------------------------------------
8   SUBROUTINE agrif_user
9   END SUBROUTINE agrif_user
10
11   SUBROUTINE agrif_before_regridding
12   END SUBROUTINE agrif_before_regridding
13
14   SUBROUTINE Agrif_InitWorkspace
15   END SUBROUTINE Agrif_InitWorkspace
16
17   SUBROUTINE Agrif_InitValues
18      !!----------------------------------------------------------------------
19      !!                 *** ROUTINE Agrif_InitValues ***
20      !!----------------------------------------------------------------------
21      USE nemogcm
22      !!----------------------------------------------------------------------
23      !
24      CALL nemo_init       !* Initializations of each fine grid
25      !
26      !                    !* Agrif initialization
27      CALL agrif_nemo_init
28      CALL Agrif_InitValues_cont_dom
29      CALL Agrif_InitValues_cont
30# if defined key_top
31      CALL Agrif_InitValues_cont_top
32# endif
33# if defined key_si3
34      CALL Agrif_InitValues_cont_ice
35# endif
36      !   
37   END SUBROUTINE Agrif_initvalues
38
39   SUBROUTINE Agrif_InitValues_cont_dom
40      !!----------------------------------------------------------------------
41      !!                 *** ROUTINE Agrif_InitValues_cont_dom ***
42      !!----------------------------------------------------------------------
43      !
44      CALL agrif_declare_var_dom
45      !
46   END SUBROUTINE Agrif_InitValues_cont_dom
47
48   SUBROUTINE agrif_declare_var_dom
49      !!----------------------------------------------------------------------
50      !!                 *** ROUTINE agrif_declare_var_dom ***
51      !!----------------------------------------------------------------------
52      USE par_oce, ONLY:  nbghostcells     
53      !
54      IMPLICIT NONE
55      !
56      INTEGER :: ind1, ind2, ind3
57      !!----------------------------------------------------------------------
58
59      ! 1. Declaration of the type of variable which have to be interpolated
60      !---------------------------------------------------------------------
61      ind1 =     nbghostcells
62      ind2 = 1 + nbghostcells
63      ind3 = 2 + nbghostcells
64      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
65      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
66
67      ! 2. Type of interpolation
68      !-------------------------
69      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
70      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
71
72      ! 3. Location of interpolation
73      !-----------------------------
74      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
75      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
76
77      ! 4. Update type
78      !---------------
79# if defined UPD_HIGH
80      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
81      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
82#else
83      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
84      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
85#endif
86
87   END SUBROUTINE agrif_declare_var_dom
88
89   SUBROUTINE Agrif_InitValues_cont
90      !!----------------------------------------------------------------------
91      !!                 *** ROUTINE Agrif_InitValues_cont ***
92      !!----------------------------------------------------------------------
93      USE agrif_oce
94      USE agrif_oce_interp
95      USE agrif_oce_sponge
96      USE dom_oce
97      USE oce
98      USE lib_mpp
99      USE lbclnk
100      !
101      IMPLICIT NONE
102      !
103      INTEGER :: ji, jj
104      LOGICAL :: check_namelist
105      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
106#if defined key_vertical
107      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
108#endif
109      !!----------------------------------------------------------------------
110
111      ! 1. Declaration of the type of variable which have to be interpolated
112      !---------------------------------------------------------------------
113      CALL agrif_declare_var
114
115      ! 2. First interpolations of potentially non zero fields
116      !-------------------------------------------------------
117
118#if defined key_vertical
119      ! Build consistent parent bathymetry and number of levels
120      ! on the child grid
121      Agrif_UseSpecialValue = .FALSE.
122      ht0_parent(:,:) = 0._wp
123      mbkt_parent(:,:) = 0
124      !
125      CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
126      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
127      !
128      DO jj = 1, jpjm1
129         DO ji = 1, jpim1
130            hu0_parent(ji,jj)  = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 
131            hv0_parent(ji,jj)  = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 
132            mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj)  )
133            mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj)  )
134         END DO
135      END DO
136      !
137      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. )
138      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. )
139      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. )
140      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
141      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. )
142      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )     
143#endif
144
145      Agrif_SpecialValue    = 0._wp
146      Agrif_UseSpecialValue = .TRUE.
147      CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
148      CALL Agrif_Sponge
149      tabspongedone_tsn = .FALSE.
150      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
151      ! reset tsa to zero
152      tsa(:,:,:,:) = 0._wp
153
154      Agrif_UseSpecialValue = ln_spc_dyn
155      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
156      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
157      tabspongedone_u = .FALSE.
158      tabspongedone_v = .FALSE.
159      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
160      tabspongedone_u = .FALSE.
161      tabspongedone_v = .FALSE.
162      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
163      ua(:,:,:) = 0._wp
164      va(:,:,:) = 0._wp
165
166      Agrif_UseSpecialValue = .TRUE.
167      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
168      hbdy(:,:) = 0._wp
169      ssha(:,:) = 0._wp
170
171      IF ( ln_dynspg_ts ) THEN
172         Agrif_UseSpecialValue = ln_spc_dyn
173         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
174         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
175         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
176         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
177         ubdy(:,:) = 0._wp
178         vbdy(:,:) = 0._wp
179      ENDIF
180
181      Agrif_UseSpecialValue = .FALSE.
182
183      ! 3. Some controls
184      !-----------------
185      check_namelist = .TRUE.
186
187      IF( check_namelist ) THEN 
188
189         ! Check time steps           
190         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
191            WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
192            WRITE(cl_check2,*)  NINT(rdt)
193            WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
194            CALL ctl_stop( 'Incompatible time step between ocean grids',   &
195                  &               'parent grid value : '//cl_check1    ,   & 
196                  &               'child  grid value : '//cl_check2    ,   & 
197                  &               'value on child grid should be changed to : '//cl_check3 )
198         ENDIF
199
200         ! Check run length
201         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
202               Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
203            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
204            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
205            CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
206                  &               'nit000 on fine grid will be changed to : '//cl_check1,   &
207                  &               'nitend on fine grid will be changed to : '//cl_check2    )
208            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
209            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
210         ENDIF
211
212         ! Check free surface scheme
213         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
214            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
215            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
216            WRITE(cl_check2,*)  ln_dynspg_ts
217            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
218            WRITE(cl_check4,*)  ln_dynspg_exp
219            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
220                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
221                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
222                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
223                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
224                  &               'those logicals should be identical' )                 
225            STOP
226         ENDIF
227
228         ! Check if identical linear free surface option
229         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
230            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
231            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
232            WRITE(cl_check2,*)  ln_linssh
233            CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
234                  &               'parent grid ln_linssh  :'//cl_check1     ,  &
235                  &               'child  grid ln_linssh  :'//cl_check2     ,  &
236                  &               'those logicals should be identical' )                 
237            STOP
238         ENDIF
239
240         ! check if masks and bathymetries match
241         IF(ln_chk_bathy) THEN
242            !
243            IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
244            !
245            kindic_agr = 0
246            ! check if umask agree with parent along western and eastern boundaries:
247            CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
248            ! check if vmask agree with parent along northern and southern boundaries:
249            CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
250            ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
251            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
252            !
253            CALL mpp_sum( 'agrif_user', kindic_agr )
254            IF( kindic_agr /= 0 ) THEN
255               CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
256            ELSE
257               IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
258            END IF
259         ENDIF
260
261#if defined key_vertical
262    IF ( Agrif_Parent(jpk).GT.jpk ) THEN
263       CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
264         ENDIF
265#endif
266         !
267      ENDIF
268      !
269   END SUBROUTINE Agrif_InitValues_cont
270
271   SUBROUTINE agrif_declare_var
272      !!----------------------------------------------------------------------
273      !!                 *** ROUTINE agrif_declare_var ***
274      !!----------------------------------------------------------------------
275      USE agrif_util
276      USE agrif_oce
277      USE par_oce
278      USE zdf_oce 
279      USE oce
280      !
281      IMPLICIT NONE
282      !
283      INTEGER :: ind1, ind2, ind3
284      !!----------------------------------------------------------------------
285
286      ! 1. Declaration of the type of variable which have to be interpolated
287      !---------------------------------------------------------------------
288      ind1 =     nbghostcells
289      ind2 = 1 + nbghostcells
290      ind3 = 2 + nbghostcells
291# if defined key_vertical
292      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
293      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
294
295      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
296      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
297      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
298      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
299      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
300      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
301# else
302      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
303      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
304
305      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
306      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
307      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
308      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
309      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
310      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
311# endif
312
313      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
314      CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
315      CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
316# if defined key_vertical
317      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)
318      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)
319# endif
320
321      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
322
323      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
324      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
325      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
326      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
327      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
328      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
329
330      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
331
332      IF( ln_zdftke.OR.ln_zdfgls ) THEN
333!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
334!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
335# if defined key_vertical
336         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)
337# else
338         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
339# endif
340      ENDIF
341
342      ! 2. Type of interpolation
343      !-------------------------
344      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
345
346      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
347      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
348
349      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
350
351      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
352      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
353      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
354      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
355      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
356!
357! > Divergence conserving alternative:
358!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
359!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
360!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
361!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
362!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
363!<
364
365      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
366      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
367
368      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
369      CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
370      CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
371
372# if defined key_vertical
373      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
374      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
375# endif
376
377      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
378
379      ! 3. Location of interpolation
380      !-----------------------------
381      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) )
382      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
383      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
384
385      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9
386      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
387      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
388
389      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
390      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
391      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
392      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
393      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
394
395      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 6
396      CALL Agrif_Set_bc( umsk_id, (/0,0/) )
397      CALL Agrif_Set_bc( vmsk_id, (/0,0/) )
398# if defined key_vertical
399      ! extend the interpolation zone by 1 more point than necessary:
400      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
401      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
402# endif
403
404      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
405
406      ! 4. Update type
407      !---------------
408      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
409
410# if defined UPD_HIGH
411      CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
412      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
413      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
414
415      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
416      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
417      CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
418      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
419
420      IF( ln_zdftke.OR.ln_zdfgls ) THEN
421!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
422!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
423!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
424      ENDIF
425
426#else
427      CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
428      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
429      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
430
431      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
432      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
433      CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
434      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
435
436      IF( ln_zdftke.OR.ln_zdfgls ) THEN
437!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
438!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
439!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
440      ENDIF
441
442#endif
443      !
444   END SUBROUTINE agrif_declare_var
445
446#if defined key_si3
447SUBROUTINE Agrif_InitValues_cont_ice
448      !!----------------------------------------------------------------------
449      !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
450      !!----------------------------------------------------------------------
451      USE Agrif_Util
452      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
453      USE ice
454      USE agrif_ice
455      USE in_out_manager
456      USE agrif_ice_interp
457      USE lib_mpp
458      !
459      IMPLICIT NONE
460      !!----------------------------------------------------------------------
461      !
462      ! Declaration of the type of variable which have to be interpolated (parent=>child)
463      !----------------------------------------------------------------------------------
464      CALL agrif_declare_var_ice
465
466      ! Controls
467
468      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
469      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
470      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
471      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
472      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
473
474      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
475      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
476         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
477      ENDIF
478      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
479      !----------------------------------------------------------------------
480      nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
481      CALL agrif_interp_ice('U') ! interpolation of ice velocities
482      CALL agrif_interp_ice('V') ! interpolation of ice velocities
483      CALL agrif_interp_ice('T') ! interpolation of ice tracers
484      nbstep_ice = 0   
485      !
486   END SUBROUTINE Agrif_InitValues_cont_ice
487
488   SUBROUTINE agrif_declare_var_ice
489      !!----------------------------------------------------------------------
490      !!                 *** ROUTINE agrif_declare_var_ice ***
491      !!----------------------------------------------------------------------
492      USE Agrif_Util
493      USE ice
494      USE par_oce, ONLY : nbghostcells
495      !
496      IMPLICIT NONE
497      !
498      INTEGER :: ind1, ind2, ind3
499      !!----------------------------------------------------------------------
500      !
501      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
502      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
503      !           ex.:  position=> 1,1 = not-centered (in i and j)
504      !                            2,2 =     centered (    -     )
505      !                 index   => 1,1 = one ghost line
506      !                            2,2 = two ghost lines
507      !-------------------------------------------------------------------------------------
508      ind1 =     nbghostcells
509      ind2 = 1 + nbghostcells
510      ind3 = 2 + nbghostcells
511      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)
512      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  )
513      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  )
514
515      ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
516      !-----------------------------------
517      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
518      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
519      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
520
521      ! 3. Set location of interpolations
522      !----------------------------------
523      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
524      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
525      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
526
527      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
528      !--------------------------------------------------
529# if defined UPD_HIGH
530      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
531      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
532      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
533#else
534      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
535      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
536      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
537#endif
538
539   END SUBROUTINE agrif_declare_var_ice
540#endif
541
542
543# if defined key_top
544   SUBROUTINE Agrif_InitValues_cont_top
545      !!----------------------------------------------------------------------
546      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
547      !!----------------------------------------------------------------------
548      USE Agrif_Util
549      USE oce 
550      USE dom_oce
551      USE nemogcm
552      USE par_trc
553      USE lib_mpp
554      USE trc
555      USE in_out_manager
556      USE agrif_oce_sponge
557      USE agrif_top_update
558      USE agrif_top_interp
559      USE agrif_top_sponge
560      !!
561      IMPLICIT NONE
562      !
563      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
564      LOGICAL :: check_namelist
565      !!----------------------------------------------------------------------
566
567      ! 1. Declaration of the type of variable which have to be interpolated
568      !---------------------------------------------------------------------
569      CALL agrif_declare_var_top
570
571      ! 2. First interpolations of potentially non zero fields
572      !-------------------------------------------------------
573      Agrif_SpecialValue=0._wp
574      Agrif_UseSpecialValue = .TRUE.
575      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
576      Agrif_UseSpecialValue = .FALSE.
577      CALL Agrif_Sponge
578      tabspongedone_trn = .FALSE.
579      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
580      ! reset tsa to zero
581      tra(:,:,:,:) = 0._wp
582
583      ! 3. Some controls
584      !-----------------
585      check_namelist = .TRUE.
586
587      IF( check_namelist ) THEN
588         ! Check time steps
589      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
590         WRITE(cl_check1,*)  Agrif_Parent(rdt)
591         WRITE(cl_check2,*)  rdt
592         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
593         CALL ctl_stop( 'incompatible time step between grids',   &
594               &               'parent grid value : '//cl_check1    ,   & 
595               &               'child  grid value : '//cl_check2    ,   & 
596               &               'value on child grid should be changed to  &
597               &               :'//cl_check3  )
598      ENDIF
599
600      ! Check run length
601      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
602            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
603         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
604         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
605         CALL ctl_warn( 'incompatible run length between grids'               ,   &
606               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
607               &              ' nitend on fine grid will be change to : '//cl_check2    )
608         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
609         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
610      ENDIF
611
612      ! Check passive tracer cell
613      IF( nn_dttrc .NE. 1 ) THEN
614         WRITE(*,*) 'nn_dttrc should be equal to 1'
615      ENDIF
616   ENDIF
617   !
618   END SUBROUTINE Agrif_InitValues_cont_top
619
620
621   SUBROUTINE agrif_declare_var_top
622      !!----------------------------------------------------------------------
623      !!                 *** ROUTINE agrif_declare_var_top ***
624      !!----------------------------------------------------------------------
625      USE agrif_util
626      USE agrif_oce
627      USE dom_oce
628      USE trc
629      !!
630      IMPLICIT NONE
631      !
632      INTEGER :: ind1, ind2, ind3
633      !!----------------------------------------------------------------------
634
635      ! 1. Declaration of the type of variable which have to be interpolated
636      !---------------------------------------------------------------------
637      ind1 =     nbghostcells
638      ind2 = 1 + nbghostcells
639      ind3 = 2 + nbghostcells
640# if defined key_vertical
641      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
642      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
643# else
644      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
645      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
646# endif
647
648      ! 2. Type of interpolation
649      !-------------------------
650      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
651      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
652
653      ! 3. Location of interpolation
654      !-----------------------------
655      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
656      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
657
658      ! 4. Update type
659      !---------------
660# if defined UPD_HIGH
661      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
662#else
663      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
664#endif
665   !
666   END SUBROUTINE agrif_declare_var_top
667# endif
668
669   SUBROUTINE Agrif_detect( kg, ksizex )
670      !!----------------------------------------------------------------------
671      !!                      *** ROUTINE Agrif_detect ***
672      !!----------------------------------------------------------------------
673      INTEGER, DIMENSION(2) :: ksizex
674      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
675      !!----------------------------------------------------------------------
676      !
677      RETURN
678      !
679   END SUBROUTINE Agrif_detect
680
681   SUBROUTINE agrif_nemo_init
682      !!----------------------------------------------------------------------
683      !!                     *** ROUTINE agrif_init ***
684      !!----------------------------------------------------------------------
685      USE agrif_oce 
686      USE agrif_ice
687      USE in_out_manager
688      USE lib_mpp
689      !!
690      IMPLICIT NONE
691      !
692      INTEGER  ::   ios                 ! Local integer output status for namelist read
693      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
694                       & ln_spc_dyn, ln_chk_bathy
695      !!--------------------------------------------------------------------------------------
696      !
697      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
698      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
699901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
700      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
701      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
702902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
703      IF(lwm) WRITE ( numond, namagrif )
704      !
705      IF(lwp) THEN                    ! control print
706         WRITE(numout,*)
707         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
708         WRITE(numout,*) '~~~~~~~~~~~~~~~'
709         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
710         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way
711         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
712         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
713         WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.'
714         WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
715         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
716         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
717      ENDIF
718      !
719      !
720      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
721      !
722   END SUBROUTINE agrif_nemo_init
723
724# if defined key_mpp_mpi
725
726   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
727      !!----------------------------------------------------------------------
728      !!                     *** ROUTINE Agrif_InvLoc ***
729      !!----------------------------------------------------------------------
730      USE dom_oce
731      !!
732      IMPLICIT NONE
733      !
734      INTEGER :: indglob, indloc, nprocloc, i
735      !!----------------------------------------------------------------------
736      !
737      SELECT CASE( i )
738      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
739      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
740      CASE DEFAULT
741         indglob = indloc
742      END SELECT
743      !
744   END SUBROUTINE Agrif_InvLoc
745
746   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
747      !!----------------------------------------------------------------------
748      !!                 *** ROUTINE Agrif_get_proc_info ***
749      !!----------------------------------------------------------------------
750      USE par_oce
751      !!
752      IMPLICIT NONE
753      !
754      INTEGER, INTENT(out) :: imin, imax
755      INTEGER, INTENT(out) :: jmin, jmax
756      !!----------------------------------------------------------------------
757      !
758      imin = nimppt(Agrif_Procrank+1)  ! ?????
759      jmin = njmppt(Agrif_Procrank+1)  ! ?????
760      imax = imin + jpi - 1
761      jmax = jmin + jpj - 1
762      !
763   END SUBROUTINE Agrif_get_proc_info
764
765   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
766      !!----------------------------------------------------------------------
767      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
768      !!----------------------------------------------------------------------
769      USE par_oce
770      !!
771      IMPLICIT NONE
772      !
773      INTEGER,  INTENT(in)  :: imin, imax
774      INTEGER,  INTENT(in)  :: jmin, jmax
775      INTEGER,  INTENT(in)  :: nbprocs
776      REAL(wp), INTENT(out) :: grid_cost
777      !!----------------------------------------------------------------------
778      !
779      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
780      !
781   END SUBROUTINE Agrif_estimate_parallel_cost
782
783# endif
784
785#else
786   SUBROUTINE Subcalledbyagrif
787      !!----------------------------------------------------------------------
788      !!                   *** ROUTINE Subcalledbyagrif ***
789      !!----------------------------------------------------------------------
790      WRITE(*,*) 'Impossible to be here'
791   END SUBROUTINE Subcalledbyagrif
792#endif
Note: See TracBrowser for help on using the repository browser.