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

Last change on this file since 1598 was 1465, checked in by smasson, 15 years ago

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