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 @ 1300

Last change on this file since 1300 was 1300, checked in by rblod, 15 years ago

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