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

Last change on this file since 941 was 888, checked in by ctlod, 16 years ago

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