source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/NST/agrif_user.F90 @ 12229

Last change on this file since 12229 was 12229, checked in by acc, 20 months ago

2019/dev_r11943_MERGE_2019: Merge in dev_AGRIF-01-05_merged. Fully SETTE tested

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