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

Last change on this file since 11574 was 11574, checked in by jchanut, 12 months ago

#2222, import changes from dev_r10973_AGRIF-01_jchanut_small_jpi_jpj (i.e. #2199)

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