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 NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST – NEMO

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

Last change on this file since 11760 was 11741, checked in by jchanut, 5 years ago

#2222: correct definition of parent vertical grid on the child domain to perform vertical interpolation at boundaries. Use additionnal parent depths and number of levels arrays interpolated on the child grid domain to do so.
Correction of vertical interpolation of viscosity remains to be done as well as duplication of changes for passive tracers.

  • Property svn:keywords set to Id
File size: 36.4 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, ln_spc_dyn, ln_chk_bathy
694      !!--------------------------------------------------------------------------------------
695      !
696      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
697      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
698901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
699      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
700      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
701902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
702      IF(lwm) WRITE ( numond, namagrif )
703      !
704      IF(lwp) THEN                    ! control print
705         WRITE(numout,*)
706         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
707         WRITE(numout,*) '~~~~~~~~~~~~~~~'
708         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
709         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way
710         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
711         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
712         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
713         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
714      ENDIF
715      !
716      !
717      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
718      !
719   END SUBROUTINE agrif_nemo_init
720
721# if defined key_mpp_mpi
722
723   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
724      !!----------------------------------------------------------------------
725      !!                     *** ROUTINE Agrif_InvLoc ***
726      !!----------------------------------------------------------------------
727      USE dom_oce
728      !!
729      IMPLICIT NONE
730      !
731      INTEGER :: indglob, indloc, nprocloc, i
732      !!----------------------------------------------------------------------
733      !
734      SELECT CASE( i )
735      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
736      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
737      CASE DEFAULT
738         indglob = indloc
739      END SELECT
740      !
741   END SUBROUTINE Agrif_InvLoc
742
743   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
744      !!----------------------------------------------------------------------
745      !!                 *** ROUTINE Agrif_get_proc_info ***
746      !!----------------------------------------------------------------------
747      USE par_oce
748      !!
749      IMPLICIT NONE
750      !
751      INTEGER, INTENT(out) :: imin, imax
752      INTEGER, INTENT(out) :: jmin, jmax
753      !!----------------------------------------------------------------------
754      !
755      imin = nimppt(Agrif_Procrank+1)  ! ?????
756      jmin = njmppt(Agrif_Procrank+1)  ! ?????
757      imax = imin + jpi - 1
758      jmax = jmin + jpj - 1
759      !
760   END SUBROUTINE Agrif_get_proc_info
761
762   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
763      !!----------------------------------------------------------------------
764      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
765      !!----------------------------------------------------------------------
766      USE par_oce
767      !!
768      IMPLICIT NONE
769      !
770      INTEGER,  INTENT(in)  :: imin, imax
771      INTEGER,  INTENT(in)  :: jmin, jmax
772      INTEGER,  INTENT(in)  :: nbprocs
773      REAL(wp), INTENT(out) :: grid_cost
774      !!----------------------------------------------------------------------
775      !
776      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
777      !
778   END SUBROUTINE Agrif_estimate_parallel_cost
779
780# endif
781
782#else
783   SUBROUTINE Subcalledbyagrif
784      !!----------------------------------------------------------------------
785      !!                   *** ROUTINE Subcalledbyagrif ***
786      !!----------------------------------------------------------------------
787      WRITE(*,*) 'Impossible to be here'
788   END SUBROUTINE Subcalledbyagrif
789#endif
Note: See TracBrowser for help on using the repository browser.