New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
agrif_user.F90 in NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST – NEMO

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

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

#2222: 1) create remapping module (vremap) and integration of D. Engwirda piecewise polynomial recontruction package (PPR_LIB cpp key). 2) Various bug corrections with key_vertical activated.

  • Property svn:keywords set to Id
File size: 33.8 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   !!----------------------------------------------------------------------
[11574]8   SUBROUTINE agrif_user
9   END SUBROUTINE agrif_user
[3680]10
[11574]11   SUBROUTINE agrif_before_regridding
12   END SUBROUTINE agrif_before_regridding
[3680]13
[11574]14   SUBROUTINE Agrif_InitWorkspace
15   END SUBROUTINE Agrif_InitWorkspace
[1156]16
[11574]17   SUBROUTINE Agrif_InitValues
[10068]18      !!----------------------------------------------------------------------
19      !!                 *** ROUTINE Agrif_InitValues ***
20      !!----------------------------------------------------------------------
[11574]21      USE nemogcm
[10068]22      !!----------------------------------------------------------------------
[11574]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
[2715]30# if defined key_top
[11574]31      CALL Agrif_InitValues_cont_top
[7646]32# endif
[9570]33# if defined key_si3
[11574]34      CALL Agrif_InitValues_cont_ice
[7761]35# endif
[11574]36      !   
37   END SUBROUTINE Agrif_initvalues
[2031]38
[11574]39   SUBROUTINE Agrif_InitValues_cont_dom
[10068]40      !!----------------------------------------------------------------------
[11574]41      !!                 *** ROUTINE Agrif_InitValues_cont_dom ***
[10068]42      !!----------------------------------------------------------------------
[11574]43      !
44      CALL agrif_declare_var_dom
45      !
46   END SUBROUTINE Agrif_InitValues_cont_dom
[3680]47
[11574]48   SUBROUTINE agrif_declare_var_dom
[10068]49      !!----------------------------------------------------------------------
[11574]50      !!                 *** ROUTINE agrif_declare_var_dom ***
[10068]51      !!----------------------------------------------------------------------
[11574]52      USE par_oce, ONLY:  nbghostcells     
53      !
54      IMPLICIT NONE
55      !
56      INTEGER :: ind1, ind2, ind3
[10068]57      !!----------------------------------------------------------------------
[3680]58
[10068]59      ! 1. Declaration of the type of variable which have to be interpolated
60      !---------------------------------------------------------------------
[11574]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)
[3680]66
[10068]67      ! 2. Type of interpolation
68      !-------------------------
[11574]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 )
[3680]71
[10068]72      ! 3. Location of interpolation
73      !-----------------------------
[11574]74      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
75      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
[3680]76
[10068]77      ! 4. Update type
78      !---------------
[9031]79# if defined UPD_HIGH
[11574]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)
[9031]82#else
[11574]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)
[9031]85#endif
[3680]86
[11574]87   END SUBROUTINE agrif_declare_var_dom
[3680]88
[11574]89   SUBROUTINE Agrif_InitValues_cont
[10068]90      !!----------------------------------------------------------------------
91      !!                 *** ROUTINE Agrif_InitValues_cont ***
92      !!----------------------------------------------------------------------
[11574]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 
[10068]104      !!----------------------------------------------------------------------
[390]105
[11574]106      ! 1. Declaration of the type of variable which have to be interpolated
107      !---------------------------------------------------------------------
108      CALL agrif_declare_var
[636]109
[11574]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
[390]120
[11574]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
[4326]132
[11574]133      Agrif_UseSpecialValue = .TRUE.
134      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
135      hbdy(:,:) = 0._wp
136      ssha(:,:) = 0._wp
[628]137
[11574]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
[5656]147
[11574]148      Agrif_UseSpecialValue = .FALSE.
[5656]149
[11574]150      ! 3. Some controls
151      !-----------------
152      check_namelist = .TRUE.
[3680]153
[11574]154      IF( check_namelist ) THEN 
[3680]155
[11574]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
[3680]166
[11574]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
[3680]178
[11574]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
[5930]194
[11574]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
[9031]206
[11574]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
[5656]227         !
228      ENDIF
[11574]229      !
230   END SUBROUTINE Agrif_InitValues_cont
[9031]231
[11574]232   SUBROUTINE agrif_declare_var
[10068]233      !!----------------------------------------------------------------------
[11574]234      !!                 *** ROUTINE agrif_declare_var ***
[10068]235      !!----------------------------------------------------------------------
[11574]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
[10068]245      !!----------------------------------------------------------------------
[2715]246
[11574]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
[9031]252# if defined key_vertical
[11574]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)
[9031]255
[11574]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)
[9031]262# else
[11574]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)
[2715]265
[11574]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)
[9031]272# endif
[2715]273
[11574]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)
[2715]277
[11574]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)
[5656]279
[11574]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)
[5656]286
[11574]287      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
[5656]288
[11574]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)
[9031]292# if defined key_vertical
[11574]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)
[9031]294# else
[11574]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)
[9031]296# endif
[11574]297      ENDIF
[5656]298
[11574]299      ! 2. Type of interpolation
300      !-------------------------
301      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
[2715]302
[11574]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)
[2715]305
[11574]306      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
[2715]307
[11574]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)
[4326]313
[5656]314
[11574]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)
[5656]317
[11574]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)
[5656]321
[11574]322      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
[5656]323
[11574]324      ! 3. Location of interpolation
325      !-----------------------------
[11590]326      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) )
327      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
328      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
[2715]329
[11574]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/) )
[4326]333
[11574]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/) )
[2715]339
[11574]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/) )
[2715]343
[9748]344
[11574]345      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
[5656]346
[11574]347      ! 4. Update type
348      !---------------
349      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
[2715]350
[9031]351# if defined UPD_HIGH
[11574]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)
[9031]355
[11574]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)
[9031]360
[11574]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
[9031]366
367#else
[11574]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)
[3680]371
[11574]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)
[5656]376
[11574]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
[5656]382
[9031]383#endif
[11574]384      !
385   END SUBROUTINE agrif_declare_var
[3680]386
[9570]387#if defined key_si3
[9610]388SUBROUTINE Agrif_InitValues_cont_ice
[10068]389      !!----------------------------------------------------------------------
390      !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
391      !!----------------------------------------------------------------------
[11574]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
[10068]401      !!----------------------------------------------------------------------
[11574]402      !
403      ! Declaration of the type of variable which have to be interpolated (parent=>child)
404      !----------------------------------------------------------------------------------
405      CALL agrif_declare_var_ice
[3680]406
[11574]407      ! Controls
[7761]408
[11574]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')
[7761]414
[11574]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
[7646]428
[11574]429   SUBROUTINE agrif_declare_var_ice
[10068]430      !!----------------------------------------------------------------------
431      !!                 *** ROUTINE agrif_declare_var_ice ***
432      !!----------------------------------------------------------------------
[11574]433      USE Agrif_Util
434      USE ice
435      USE par_oce, ONLY : nbghostcells
436      !
437      IMPLICIT NONE
438      !
439      INTEGER :: ind1, ind2, ind3
[10068]440      !!----------------------------------------------------------------------
[11574]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  )
[7646]455
[11574]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)
[7646]461
[11574]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/))
[7646]467
[11574]468      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
469      !--------------------------------------------------
[9134]470# if defined UPD_HIGH
[11574]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       )
[9134]474#else
[11574]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   )
[9134]478#endif
[7646]479
[11574]480   END SUBROUTINE agrif_declare_var_ice
[7646]481#endif
482
483
[2715]484# if defined key_top
[11574]485   SUBROUTINE Agrif_InitValues_cont_top
[10068]486      !!----------------------------------------------------------------------
487      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
[11574]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
[10068]501      !!
[11574]502      IMPLICIT NONE
503      !
504      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
505      LOGICAL :: check_namelist
[10068]506      !!----------------------------------------------------------------------
[1300]507
[11574]508      ! 1. Declaration of the type of variable which have to be interpolated
509      !---------------------------------------------------------------------
510      CALL agrif_declare_var_top
[1300]511
[11574]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
[3680]523
[11574]524      ! 3. Some controls
525      !-----------------
526      check_namelist = .TRUE.
[3680]527
[11574]528      IF( check_namelist ) THEN
529         ! Check time steps
[5656]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()
[7646]534         CALL ctl_stop( 'incompatible time step between grids',   &
[5656]535               &               'parent grid value : '//cl_check1    ,   & 
536               &               'child  grid value : '//cl_check2    ,   & 
[7646]537               &               'value on child grid should be changed to  &
[5656]538               &               :'//cl_check3  )
[3680]539      ENDIF
540
541      ! Check run length
542      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[5656]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()
[3680]551      ENDIF
552
553      ! Check passive tracer cell
[5656]554      IF( nn_dttrc .NE. 1 ) THEN
[3680]555         WRITE(*,*) 'nn_dttrc should be equal to 1'
[1300]556      ENDIF
[3680]557   ENDIF
[5656]558   !
[11574]559   END SUBROUTINE Agrif_InitValues_cont_top
[2715]560
561
[11574]562   SUBROUTINE agrif_declare_var_top
[10068]563      !!----------------------------------------------------------------------
564      !!                 *** ROUTINE agrif_declare_var_top ***
[11574]565      !!----------------------------------------------------------------------
566      USE agrif_util
567      USE agrif_oce
568      USE dom_oce
569      USE trc
[10068]570      !!
[11574]571      IMPLICIT NONE
572      !
573      INTEGER :: ind1, ind2, ind3
[10068]574      !!----------------------------------------------------------------------
[2715]575
[11574]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
[9031]581# if defined key_vertical
[11574]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)
[9031]584# else
[11574]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)
[9031]587# endif
[2715]588
[11574]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)
[3680]593
[11574]594      ! 3. Location of interpolation
595      !-----------------------------
[11590]596      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
[11574]597      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
[3680]598
[11574]599      ! 4. Update type
600      !---------------
[9031]601# if defined UPD_HIGH
[11574]602      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
[9031]603#else
[11574]604      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
[9031]605#endif
[5656]606   !
[11574]607   END SUBROUTINE agrif_declare_var_top
[2715]608# endif
[636]609
[11574]610   SUBROUTINE Agrif_detect( kg, ksizex )
[10068]611      !!----------------------------------------------------------------------
612      !!                      *** ROUTINE Agrif_detect ***
613      !!----------------------------------------------------------------------
[11574]614      INTEGER, DIMENSION(2) :: ksizex
615      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
[10068]616      !!----------------------------------------------------------------------
[11574]617      !
618      RETURN
619      !
620   END SUBROUTINE Agrif_detect
[390]621
[11574]622   SUBROUTINE agrif_nemo_init
[10068]623      !!----------------------------------------------------------------------
624      !!                     *** ROUTINE agrif_init ***
625      !!----------------------------------------------------------------------
[11574]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
[10068]635      !!--------------------------------------------------------------------------------------
[11574]636      !
637      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
638      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
[11573]639901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
[11574]640      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
641      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
[11573]642902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
[11574]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
[3680]661
[1605]662# if defined key_mpp_mpi
663
[11574]664   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
[10068]665      !!----------------------------------------------------------------------
666      !!                     *** ROUTINE Agrif_InvLoc ***
667      !!----------------------------------------------------------------------
[11574]668      USE dom_oce
669      !!
670      IMPLICIT NONE
671      !
672      INTEGER :: indglob, indloc, nprocloc, i
[10068]673      !!----------------------------------------------------------------------
[11574]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
[390]683
[11574]684   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
[10068]685      !!----------------------------------------------------------------------
686      !!                 *** ROUTINE Agrif_get_proc_info ***
687      !!----------------------------------------------------------------------
[11574]688      USE par_oce
689      !!
690      IMPLICIT NONE
691      !
692      INTEGER, INTENT(out) :: imin, imax
693      INTEGER, INTENT(out) :: jmin, jmax
[10068]694      !!----------------------------------------------------------------------
[11574]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
[5656]702
[11574]703   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
[10068]704      !!----------------------------------------------------------------------
705      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
706      !!----------------------------------------------------------------------
[11574]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
[10068]715      !!----------------------------------------------------------------------
[11574]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
[5656]720
[1605]721# endif
722
[390]723#else
[11574]724   SUBROUTINE Subcalledbyagrif
[10068]725      !!----------------------------------------------------------------------
726      !!                   *** ROUTINE Subcalledbyagrif ***
727      !!----------------------------------------------------------------------
[11574]728      WRITE(*,*) 'Impossible to be here'
729   END SUBROUTINE Subcalledbyagrif
[390]730#endif
Note: See TracBrowser for help on using the repository browser.