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_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST – NEMO

source: NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_user.F90 @ 11244

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

#2199, clean old namelist variables

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