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

source: branches/dev_001_SBC/NEMO/NST_SRC/agrif_user.F90 @ 881

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

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