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

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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