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

Last change on this file since 1156 was 1156, checked in by rblod, 16 years ago

Update Id and licence information, see ticket #210
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.5 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   SUBROUTINE Agrif_InitValues
54      !!------------------------------------------
55      !!   *** ROUTINE Agrif_InitValues ***
56      !!
57      !! ** Purpose :: Declaration of variables to
58      !!               be interpolated
59      !!------------------------------------------
60      USE Agrif_Util
61      USE oce 
62      USE dom_oce
63      USE opa
64      USE sms
65#if defined key_tradmp   ||   defined key_esopa
66      USE tradmp
67#endif
68      USE sol_oce
69      USE in_out_manager
70#if defined key_lim3 || defined key_lim2
71      USE ice_oce
72#endif
73      USE agrif_opa_update
74      USE agrif_opa_interp
75      USE agrif_opa_sponge
76      USE agrif_top_update
77      USE agrif_top_interp
78
79      IMPLICIT NONE
80
81      REAL(wp) :: tabtemp(jpi,jpj,jpk)
82#if defined key_passivetrc
83      REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra)
84#endif
85      LOGICAL check_namelist
86
87      ! 0. Initializations
88      !-------------------
89#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
90      jp_cfg = -1    ! set special value for jp_cfg on fine grids
91      cp_cfg = "default"
92#endif
93
94      Call opa_init  ! Initializations of each fine grid
95      Call agrif_opa_init
96
97      ! Specific fine grid Initializations
98#if defined key_tradmp || defined key_esopa
99      ! no tracer damping on fine grids
100      lk_tradmp = .FALSE.
101#endif
102      ! 1. Declaration of the type of variable which have to be interpolated
103      !---------------------------------------------------------------------
104      Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/))
105      Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/))
106
107      Call Agrif_Set_type(ua,(/1,2,0/),(/2,3,0/))
108      Call Agrif_Set_type(va,(/2,1,0/),(/3,2,0/))
109
110      Call Agrif_Set_type(e1u,(/1,2/),(/2,3/))
111      Call Agrif_Set_type(e2v,(/2,1/),(/3,2/))
112
113      Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/))
114      Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/)) 
115
116      Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/))
117      Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/)) 
118
119      Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/))
120      Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/))       
121
122      Call Agrif_Set_type(sshn,(/2,2/),(/3,3/))
123      Call Agrif_Set_type(gcb,(/2,2/),(/3,3/))
124
125#if defined key_passivetrc
126      Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/))
127      Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/))
128      Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/))
129#endif
130     
131      ! 2. Space directions for each variables
132      !---------------------------------------
133      Call Agrif_Set_raf(un,(/'x','y','N'/))
134      Call Agrif_Set_raf(vn,(/'x','y','N'/))
135
136      Call Agrif_Set_raf(ua,(/'x','y','N'/))
137      Call Agrif_Set_raf(va,(/'x','y','N'/))
138
139      Call Agrif_Set_raf(e1u,(/'x','y'/))
140      Call Agrif_Set_raf(e2v,(/'x','y'/))
141
142      Call Agrif_Set_raf(tn,(/'x','y','N'/))
143      Call Agrif_Set_raf(sn,(/'x','y','N'/))
144
145      Call Agrif_Set_raf(tb,(/'x','y','N'/))
146      Call Agrif_Set_raf(sb,(/'x','y','N'/))
147
148      Call Agrif_Set_raf(ta,(/'x','y','N'/))
149      Call Agrif_Set_raf(sa,(/'x','y','N'/))     
150
151      Call Agrif_Set_raf(sshn,(/'x','y'/))
152      Call Agrif_Set_raf(gcb,(/'x','y'/))
153
154#if defined key_passivetrc
155      Call Agrif_Set_raf(trb,(/'x','y','N','N'/))
156      Call Agrif_Set_raf(trn,(/'x','y','N','N'/))
157      Call Agrif_Set_raf(tra,(/'x','y','N','N'/))
158#endif
159
160      ! 3. Type of interpolation
161      !-------------------------
162      Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear)
163      Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear)
164
165      Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear)
166      Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear)
167
168      Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm)
169      Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear)
170
171      Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm)
172      Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear)
173
174      Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm)
175      Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear)
176
177#if defined key_passivetrc
178      Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear)
179      Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear)
180#endif
181
182      ! 4. Location of interpolation
183      !-----------------------------
184      Call Agrif_Set_bc(un,(/0,1/))
185      Call Agrif_Set_bc(vn,(/0,1/))
186
187      Call Agrif_Set_bc(e1u,(/0,0/))
188      Call Agrif_Set_bc(e2v,(/0,0/))
189
190      Call Agrif_Set_bc(tn,(/0,1/))
191      Call Agrif_Set_bc(sn,(/0,1/))
192
193      Call Agrif_Set_bc(ta,(/-3*Agrif_irhox(),0/))
194      Call Agrif_Set_bc(sa,(/-3*Agrif_irhox(),0/))
195
196      Call Agrif_Set_bc(ua,(/-2*Agrif_irhox(),0/))
197      Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/))
198
199#if defined key_passivetrc
200      Call Agrif_Set_bc(trn,(/0,1/))
201      Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/))
202#endif
203
204      ! 5. Update type
205      !---------------
206      Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average)
207      Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average)
208
209      Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average)
210      Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average)
211
212      Call Agrif_Set_Updatetype(sshn, update = AGRIF_Update_Average)
213      Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average)
214
215#if defined key_passivetrc
216      Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average)
217      Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average)
218#endif
219
220      Call Agrif_Set_Updatetype(un,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
221      Call Agrif_Set_Updatetype(vn,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
222
223      Call Agrif_Set_Updatetype(e1u,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
224      Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
225
226      ! 6. First interpolations of potentially non zero fields
227      !-------------------------------------------------------
228      Agrif_SpecialValue=0.
229      Agrif_UseSpecialValue = .TRUE.
230      Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.)
231      Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.)
232      Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu)
233      Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv)
234
235      Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn)
236      Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn)
237
238      Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun)
239      Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn)
240
241#if defined key_passivetrc
242      Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.)
243      Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.)
244#endif
245      Agrif_UseSpecialValue = .FALSE.
246
247      ! 7. Some controls
248      !-----------------
249      check_namelist = .true.
250           
251      IF( check_namelist ) THEN
252     
253         ! Check time steps           
254         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
255            WRITE(*,*) 'incompatible time step between grids'
256            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
257            WRITE(*,*) 'child  grid value : ',nint(rdt)
258            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
259            STOP
260         ENDIF
261         
262         ! Check run length
263         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
264            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
265            WRITE(*,*) 'incompatible run length between grids'
266            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
267               Agrif_Parent(nit000)+1),' time step'
268            WRITE(*,*) 'child  grid value : ', &
269               (nitend-nit000+1),' time step'
270            WRITE(*,*) 'value on child grid should be : ', &
271               Agrif_IRhot() * (Agrif_Parent(nitend)- &
272               Agrif_Parent(nit000)+1)
273            STOP
274         ENDIF
275         
276         ! Check coordinates
277         IF( ln_zps ) THEN
278            ! check parameters for partial steps
279            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
280               WRITE(*,*) 'incompatible e3zps_min between grids'
281               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
282               WRITE(*,*) 'child grid  :',e3zps_min
283               WRITE(*,*) 'those values should be identical'
284               STOP
285            ENDIF         
286            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
287               WRITE(*,*) 'incompatible e3zps_rat between grids'
288               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
289               WRITE(*,*) 'child grid  :',e3zps_rat
290               WRITE(*,*) 'those values should be identical'                 
291               STOP
292            ENDIF
293         ENDIF
294
295      ENDIF
296
297      CALL Agrif_Update_tra(0)
298      CALL Agrif_Update_dyn(0)
299
300      nbcline = 0
301
302   END SUBROUTINE Agrif_InitValues
303   !
304   
305SUBROUTINE Agrif_detect(g,sizex)
306      !!------------------------------------------
307      !!   *** ROUTINE Agrif_detect ***
308      !!------------------------------------------
309      USE Agrif_Types
310 
311      INTEGER, DIMENSION(2) :: sizex
312      INTEGER, DIMENSION(sizex(1),sizex(2)) :: g 
313
314      Return
315
316   End SUBROUTINE Agrif_detect
317
318   SUBROUTINE agrif_opa_init
319      !!---------------------------------------------
320      !!   *** ROUTINE agrif_init ***
321      !!---------------------------------------------
322      USE agrif_oce 
323      USE in_out_manager
324
325      IMPLICIT NONE
326
327      NAMELIST/namagrif/ nbclineupdate, visc_tra, visc_dyn, ln_spc_dyn
328
329      REWIND ( numnam )
330      READ   ( numnam, namagrif )
331      IF(lwp) THEN
332         WRITE(numout,*)
333         WRITE(numout,*) 'agrif_opa_init : agrif parameters'
334         WRITE(numout,*) '~~~~~~~~~~~~'
335         WRITE(numout,*) '          Namelist namagrif : set agrif parameters'
336         WRITE(numout,*) '             baroclinic update frequency          =  ', nbclineupdate
337         WRITE(numout,*) '             sponge coefficient for tracers       =  ', visc_tra
338         WRITE(numout,*) '             sponge coefficient for dynamics      =  ', visc_dyn
339         WRITE(numout,*) '             use special values for dynamics      =  ', ln_spc_dyn
340         WRITE(numout,*) 
341      ENDIF
342
343    END SUBROUTINE agrif_opa_init
344#if defined key_mpp_mpi
345   SUBROUTINE Agrif_InvLoc(indloc,nprocloc,i,indglob)
346      !!------------------------------------------
347      !!   *** ROUTINE Agrif_detect ***
348      !!------------------------------------------
349      USE dom_oce
350     
351      IMPLICIT NONE
352
353      INTEGER :: indglob,indloc,nprocloc,i
354
355      SELECT CASE(i)
356      CASE(1)
357         indglob = indloc + nimppt(nprocloc+1) - 1
358      CASE(2)
359         indglob = indloc + njmppt(nprocloc+1) - 1 
360      CASE(3)
361         indglob = indloc
362      CASE(4)
363         indglob = indloc
364      END SELECT
365
366   END SUBROUTINE Agrif_InvLoc
367#endif
368#else
369   SUBROUTINE Subcalledbyagrif
370      !!------------------------------------------
371      !!   *** ROUTINE Subcalledbyagrif ***
372      !!------------------------------------------
373      WRITE(*,*) 'Impossible to be here'
374   END SUBROUTINE Subcalledbyagrif
375#endif
Note: See TracBrowser for help on using the repository browser.