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 trunk/NEMO/NST_SRC – NEMO

source: trunk/NEMO/NST_SRC/agrif_user.F90 @ 1605

Last change on this file since 1605 was 1605, checked in by ctlod, 15 years ago

Doctor naming of OPA namelist variables, see ticket: #526
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 18.7 KB
Line 
1#if defined key_agrif
2   !!----------------------------------------------------------------------
3   !!   OPA 9.0 , LOCEAN-IPSL (2006)
4   !! $Id$
5   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
6   !!----------------------------------------------------------------------
7
8   SUBROUTINE Agrif_InitWorkspace
9      !!----------------------------------------------------------------------
10      !!                 *** ROUTINE Agrif_InitWorkspace ***
11      !!----------------------------------------------------------------------
12      USE par_oce
13      USE dom_oce
14      USE Agrif_Util
15      !!
16      IMPLICIT NONE
17      !!
18#if defined key_mpp_dyndist
19      CHARACTER(len=20) :: namelistname
20      INTEGER nummpp
21      NAMELIST/nammpp_dyndist/ jpni, jpnj, jpnij
22#endif
23      !!----------------------------------------------------------------------
24
25#if defined key_mpp_dyndist
26      ! MPP dynamical distribution : read the processor cutting in the namelist
27      IF( Agrif_Nbstepint() == 0 ) THEN
28        nummpp = Agrif_Get_Unit()
29        namelistname='namelist'
30        IF(.NOT. Agrif_Root() )   namelistname=TRIM(Agrif_CFixed())//'_namelist'
31        !
32        OPEN (nummpp,file=namelistname,status='OLD',form='formatted')
33        READ (nummpp,nammpp_dyndist)
34        CLOSE(nummpp)
35      ENDIF
36#endif
37
38      IF( .NOT. Agrif_Root() ) THEN
39         jpiglo  = nbcellsx + 2 + 2*nbghostcells
40         jpjglo  = nbcellsy + 2 + 2*nbghostcells
41         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
42         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
43         jpim1   = jpi-1
44         jpjm1   = jpj-1
45         jpkm1   = jpk-1                                       
46         jpij    = jpi*jpj
47         jpidta  = jpiglo
48         jpjdta  = jpjglo
49         jpizoom = 1
50         jpjzoom = 1
51         nperio  = 0
52         jperio  = 0
53      ENDIF
54      !
55   END SUBROUTINE Agrif_InitWorkspace
56
57#if ! defined key_off_tra
58
59   SUBROUTINE Agrif_InitValues
60      !!----------------------------------------------------------------------
61      !!                 *** ROUTINE Agrif_InitValues ***
62      !!
63      !! ** Purpose :: Declaration of variables to be interpolated
64      !!----------------------------------------------------------------------
65      USE Agrif_Util
66      USE oce 
67      USE dom_oce
68      USE opa
69#if defined key_top
70      USE trc
71#endif
72#if defined key_tradmp   ||   defined key_esopa
73      USE tradmp
74#endif
75      USE sol_oce
76      USE in_out_manager
77      USE agrif_opa_update
78      USE agrif_opa_interp
79      USE agrif_opa_sponge
80      USE agrif_top_update
81      USE agrif_top_interp
82      USE agrif_top_sponge
83      !!
84      IMPLICIT NONE
85      !!
86      REAL(wp) :: tabtemp(jpi,jpj,jpk)
87#if defined key_top
88      REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra)
89#endif
90      LOGICAL check_namelist
91      !!----------------------------------------------------------------------
92
93      ! 0. Initializations
94      !-------------------
95#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
96      jp_cfg = -1    ! set special value for jp_cfg on fine grids
97      cp_cfg = "default"
98#endif
99
100      Call opa_init  ! Initializations of each fine grid
101      Call agrif_opa_init
102
103      ! Specific fine grid Initializations
104#if defined key_tradmp || defined key_esopa
105      ! no tracer damping on fine grids
106      lk_tradmp = .FALSE.
107#endif
108      ! 1. Declaration of the type of variable which have to be interpolated
109      !---------------------------------------------------------------------
110      Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/))
111      Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/))
112
113      Call Agrif_Set_type(ua,(/1,2,0/),(/2,3,0/))
114      Call Agrif_Set_type(va,(/2,1,0/),(/3,2,0/))
115
116      Call Agrif_Set_type(e1u,(/1,2/),(/2,3/))
117      Call Agrif_Set_type(e2v,(/2,1/),(/3,2/))
118
119      Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/))
120      Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/)) 
121
122      Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/))
123      Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/)) 
124
125      Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/))
126      Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/))       
127
128      Call Agrif_Set_type(sshn,(/2,2/),(/3,3/))
129      Call Agrif_Set_type(gcb,(/2,2/),(/3,3/))
130
131#if defined key_top
132      Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/))
133      Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/))
134      Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/))
135#endif
136     
137      ! 2. Space directions for each variables
138      !---------------------------------------
139      Call Agrif_Set_raf(un,(/'x','y','N'/))
140      Call Agrif_Set_raf(vn,(/'x','y','N'/))
141
142      Call Agrif_Set_raf(ua,(/'x','y','N'/))
143      Call Agrif_Set_raf(va,(/'x','y','N'/))
144
145      Call Agrif_Set_raf(e1u,(/'x','y'/))
146      Call Agrif_Set_raf(e2v,(/'x','y'/))
147
148      Call Agrif_Set_raf(tn,(/'x','y','N'/))
149      Call Agrif_Set_raf(sn,(/'x','y','N'/))
150
151      Call Agrif_Set_raf(tb,(/'x','y','N'/))
152      Call Agrif_Set_raf(sb,(/'x','y','N'/))
153
154      Call Agrif_Set_raf(ta,(/'x','y','N'/))
155      Call Agrif_Set_raf(sa,(/'x','y','N'/))     
156
157      Call Agrif_Set_raf(sshn,(/'x','y'/))
158      Call Agrif_Set_raf(gcb,(/'x','y'/))
159
160#if defined key_top
161      Call Agrif_Set_raf(trn,(/'x','y','N','N'/))
162      Call Agrif_Set_raf(trb,(/'x','y','N','N'/))
163      Call Agrif_Set_raf(tra,(/'x','y','N','N'/))
164#endif
165
166      ! 3. Type of interpolation
167      !-------------------------
168      Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear)
169      Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear)
170
171      Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear)
172      Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear)
173
174      Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm)
175      Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear)
176
177      Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm)
178      Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear)
179
180      Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm)
181      Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear)
182
183#if defined key_top
184      Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear)
185      Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear)
186#endif
187
188      ! 4. Location of interpolation
189      !-----------------------------
190      Call Agrif_Set_bc(un,(/0,1/))
191      Call Agrif_Set_bc(vn,(/0,1/))
192
193      Call Agrif_Set_bc(e1u,(/0,0/))
194      Call Agrif_Set_bc(e2v,(/0,0/))
195
196      Call Agrif_Set_bc(tn,(/0,1/))
197      Call Agrif_Set_bc(sn,(/0,1/))
198
199      Call Agrif_Set_bc(ta,(/-3*Agrif_irhox(),0/))
200      Call Agrif_Set_bc(sa,(/-3*Agrif_irhox(),0/))
201
202      Call Agrif_Set_bc(ua,(/-2*Agrif_irhox(),0/))
203      Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/))
204
205#if defined key_top
206      Call Agrif_Set_bc(trn,(/0,1/))
207      Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/))
208#endif
209
210      ! 5. Update type
211      !---------------
212      Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average)
213      Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average)
214
215      Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average)
216      Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average)
217
218      Call Agrif_Set_Updatetype(sshn, update = AGRIF_Update_Average)
219      Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average)
220
221#if defined key_top
222      Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average)
223      Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average)
224#endif
225
226      Call Agrif_Set_Updatetype(un,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
227      Call Agrif_Set_Updatetype(vn,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
228
229      Call Agrif_Set_Updatetype(e1u,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
230      Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
231
232      ! 6. First interpolations of potentially non zero fields
233      !-------------------------------------------------------
234      Agrif_SpecialValue=0.
235      Agrif_UseSpecialValue = .TRUE.
236      Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.)
237      Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.)
238      Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu)
239      Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv)
240
241      Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn)
242      Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn)
243
244      Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun)
245      Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn)
246
247#if defined key_top
248      Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.)
249      Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn)
250#endif
251      Agrif_UseSpecialValue = .FALSE.
252
253      ! 7. Some controls
254      !-----------------
255      check_namelist = .true.
256           
257      IF( check_namelist ) THEN
258     
259         ! Check time steps           
260         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
261            WRITE(*,*) 'incompatible time step between grids'
262            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
263            WRITE(*,*) 'child  grid value : ',nint(rdt)
264            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
265            STOP
266         ENDIF
267         
268         ! Check run length
269         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
270            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
271            WRITE(*,*) 'incompatible run length between grids'
272            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
273               Agrif_Parent(nit000)+1),' time step'
274            WRITE(*,*) 'child  grid value : ', &
275               (nitend-nit000+1),' time step'
276            WRITE(*,*) 'value on child grid should be : ', &
277               Agrif_IRhot() * (Agrif_Parent(nitend)- &
278               Agrif_Parent(nit000)+1)
279            STOP
280         ENDIF
281         
282         ! Check coordinates
283         IF( ln_zps ) THEN
284            ! check parameters for partial steps
285            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
286               WRITE(*,*) 'incompatible e3zps_min between grids'
287               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
288               WRITE(*,*) 'child grid  :',e3zps_min
289               WRITE(*,*) 'those values should be identical'
290               STOP
291            ENDIF         
292            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
293               WRITE(*,*) 'incompatible e3zps_rat between grids'
294               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
295               WRITE(*,*) 'child grid  :',e3zps_rat
296               WRITE(*,*) 'those values should be identical'                 
297               STOP
298            ENDIF
299         ENDIF
300#if defined key_top
301        ! Check passive tracer cell
302        IF( ndttrc .ne. 1 ) THEN
303           WRITE(*,*) 'ndttrc should be equal to 1'
304        ENDIF
305#endif
306
307      ENDIF
308
309#if defined key_top
310      CALL Agrif_Update_trc(0)
311#endif
312      CALL Agrif_Update_tra(0)
313      CALL Agrif_Update_dyn(0)
314
315#if defined key_top
316      nbcline_trc = 0
317#endif
318      nbcline = 0
319      !
320   END SUBROUTINE Agrif_InitValues
321
322#else
323
324   SUBROUTINE Agrif_InitValues
325      !!----------------------------------------------------------------------
326      !!                 *** ROUTINE Agrif_InitValues ***
327      !!
328      !! ** Purpose :: Declaration of variables to be interpolated
329      !!----------------------------------------------------------------------
330      USE Agrif_Util
331      USE oce 
332      USE dom_oce
333      USE opa
334      USE trc
335      USE in_out_manager
336      USE agrif_top_update
337      USE agrif_top_interp
338      USE agrif_top_sponge
339      !!
340      IMPLICIT NONE
341      !!
342      REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra)
343      LOGICAL check_namelist
344      !!----------------------------------------------------------------------
345
346      ! 0. Initializations
347      !-------------------
348#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
349      jp_cfg = -1    ! set special value for jp_cfg on fine grids
350      cp_cfg = "default"
351#endif
352
353      Call opa_init  ! Initializations of each fine grid
354      Call agrif_opa_init
355
356      ! 1. Declaration of the type of variable which have to be interpolated
357      !---------------------------------------------------------------------
358      Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/))
359      Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/))
360      Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/))
361     
362      ! 2. Space directions for each variables
363      !---------------------------------------
364      Call Agrif_Set_raf(trn,(/'x','y','N','N'/))
365      Call Agrif_Set_raf(trb,(/'x','y','N','N'/))
366      Call Agrif_Set_raf(tra,(/'x','y','N','N'/))
367
368      ! 3. Type of interpolation
369      !-------------------------
370      Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear)
371      Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear)
372
373      ! 4. Location of interpolation
374      !-----------------------------
375      Call Agrif_Set_bc(trn,(/0,1/))
376      Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/))
377
378      ! 5. Update type
379      !---------------
380      Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average)
381      Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average)
382
383      ! 6. First interpolations of potentially non zero fields
384      !-------------------------------------------------------
385      Agrif_SpecialValue=0.
386      Agrif_UseSpecialValue = .TRUE.
387      Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.)
388      Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn)
389      Agrif_UseSpecialValue = .FALSE.
390
391      ! 7. Some controls
392      !-----------------
393      check_namelist = .true.
394           
395      IF( check_namelist ) THEN
396     
397         ! Check time steps           
398         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
399            WRITE(*,*) 'incompatible time step between grids'
400            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
401            WRITE(*,*) 'child  grid value : ',nint(rdt)
402            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
403            STOP
404         ENDIF
405         
406         ! Check run length
407         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
408            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
409            WRITE(*,*) 'incompatible run length between grids'
410            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
411               Agrif_Parent(nit000)+1),' time step'
412            WRITE(*,*) 'child  grid value : ', &
413               (nitend-nit000+1),' time step'
414            WRITE(*,*) 'value on child grid should be : ', &
415               Agrif_IRhot() * (Agrif_Parent(nitend)- &
416               Agrif_Parent(nit000)+1)
417            STOP
418         ENDIF
419         
420         ! Check coordinates
421         IF( ln_zps ) THEN
422            ! check parameters for partial steps
423            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
424               WRITE(*,*) 'incompatible e3zps_min between grids'
425               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
426               WRITE(*,*) 'child grid  :',e3zps_min
427               WRITE(*,*) 'those values should be identical'
428               STOP
429            ENDIF         
430            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
431               WRITE(*,*) 'incompatible e3zps_rat between grids'
432               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
433               WRITE(*,*) 'child grid  :',e3zps_rat
434               WRITE(*,*) 'those values should be identical'                 
435               STOP
436            ENDIF
437         ENDIF
438        ! Check passive tracer cell
439        IF( ndttrc .ne. 1 ) THEN
440           WRITE(*,*) 'ndttrc should be equal to 1'
441        ENDIF
442
443      ENDIF
444
445      CALL Agrif_Update_trc(0)
446      nbcline_trc = 0
447      !
448   END SUBROUTINE Agrif_InitValues
449
450#endif
451   
452   SUBROUTINE Agrif_detect( g, sizex )
453      !!----------------------------------------------------------------------
454      !!   *** ROUTINE Agrif_detect ***
455      !!----------------------------------------------------------------------
456      USE Agrif_Types
457      !!
458      INTEGER, DIMENSION(2) :: sizex
459      INTEGER, DIMENSION(sizex(1),sizex(2)) :: g 
460      !!----------------------------------------------------------------------
461      !
462      RETURN
463      !
464   END SUBROUTINE Agrif_detect
465
466
467   SUBROUTINE agrif_opa_init
468      !!----------------------------------------------------------------------
469      !!                     *** ROUTINE agrif_init ***
470      !!----------------------------------------------------------------------
471      USE agrif_oce 
472      USE in_out_manager
473      !!
474      IMPLICIT NONE
475      !!
476      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
477      !!----------------------------------------------------------------------
478
479      REWIND( numnam )                ! Read namagrif namelist
480      READ  ( numnam, namagrif )
481      !
482      IF(lwp) THEN                    ! control print
483         WRITE(numout,*)
484         WRITE(numout,*) 'agrif_opa_init : AGRIF parameters'
485         WRITE(numout,*) '~~~~~~~~~~~~'
486         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
487         WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
488         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
489         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
490         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
491         WRITE(numout,*) 
492      ENDIF
493      !
494      ! convert DOCTOR namelist name into OLD names
495      nbclineupdate = nn_cln_update
496      visc_tra      = rn_sponge_tra
497      visc_dyn      = rn_sponge_dyn
498      !
499    END SUBROUTINE agrif_opa_init
500
501# if defined key_mpp_mpi
502
503   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
504      !!----------------------------------------------------------------------
505      !!                     *** ROUTINE Agrif_detect ***
506      !!----------------------------------------------------------------------
507      USE dom_oce
508      !!
509      IMPLICIT NONE
510      !!
511      INTEGER :: indglob,indloc,nprocloc,i
512      !!----------------------------------------------------------------------
513      !
514      SELECT CASE(i)
515      CASE(1)
516         indglob = indloc + nimppt(nprocloc+1) - 1
517      CASE(2)
518         indglob = indloc + njmppt(nprocloc+1) - 1 
519      CASE(3)
520         indglob = indloc
521      CASE(4)
522         indglob = indloc
523      END SELECT
524      !
525   END SUBROUTINE Agrif_InvLoc
526
527# endif
528
529#else
530   SUBROUTINE Subcalledbyagrif
531      !!----------------------------------------------------------------------
532      !!   *** ROUTINE Subcalledbyagrif ***
533      !!----------------------------------------------------------------------
534      WRITE(*,*) 'Impossible to be here'
535   END SUBROUTINE Subcalledbyagrif
536#endif
Note: See TracBrowser for help on using the repository browser.