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

source: trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk
  • Property svn:keywords set to Id
File size: 20.0 KB
Line 
1#if defined key_agrif
2   !!----------------------------------------------------------------------
3   !! NEMO/NST 3.3 , NEMO Consortium (2010)
4   !! $Id$
5   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
6   !!----------------------------------------------------------------------
7   SUBROUTINE agrif_before_regridding
8   END SUBROUTINE
9
10   SUBROUTINE Agrif_InitWorkspace
11      !!----------------------------------------------------------------------
12      !!                 *** ROUTINE Agrif_InitWorkspace ***
13      !!----------------------------------------------------------------------
14      USE par_oce
15      USE dom_oce
16      USE Agrif_Util
17      USE nemogcm
18      !
19      IMPLICIT NONE
20      !!----------------------------------------------------------------------
21      !
22      IF( .NOT. Agrif_Root() ) THEN
23         jpni = Agrif_Parent(jpni)
24         jpnj = Agrif_Parent(jpnj)
25         jpnij = Agrif_Parent(jpnij)
26         jpiglo  = nbcellsx + 2 + 2*nbghostcells
27         jpjglo  = nbcellsy + 2 + 2*nbghostcells
28         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
29         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
30         jpk     = jpkdta
31         jpim1   = jpi-1
32         jpjm1   = jpj-1
33         jpkm1   = jpk-1                                       
34         jpij    = jpi*jpj
35         jpidta  = jpiglo
36         jpjdta  = jpjglo
37         jpizoom = 1
38         jpjzoom = 1
39         nperio  = 0
40         jperio  = 0
41      ENDIF
42      !
43   END SUBROUTINE Agrif_InitWorkspace
44
45
46   SUBROUTINE Agrif_InitValues
47      !!----------------------------------------------------------------------
48      !!                 *** ROUTINE Agrif_InitValues ***
49      !!
50      !! ** Purpose :: Declaration of variables to be interpolated
51      !!----------------------------------------------------------------------
52      USE Agrif_Util
53      USE oce 
54      USE dom_oce
55      USE nemogcm
56#if defined key_tradmp   ||   defined key_esopa
57      USE tradmp
58#endif
59#if defined key_obc   ||   defined key_esopa
60      USE obc_par
61#endif
62      IMPLICIT NONE
63      !!----------------------------------------------------------------------
64
65      ! 0. Initializations
66      !-------------------
67#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
68      jp_cfg = -1    ! set special value for jp_cfg on fine grids
69      cp_cfg = "default"
70#endif
71
72      ! Specific fine grid Initializations
73#if defined key_tradmp || defined key_esopa
74      ! no tracer damping on fine grids
75      lk_tradmp = .FALSE.
76#endif
77#if defined key_obc || defined key_esopa
78      ! no open boundary on fine grids
79      lk_obc = .FALSE.
80#endif
81
82      CALL nemo_init  ! Initializations of each fine grid
83      CALL agrif_nemo_init
84# if ! defined key_offline
85      CALL Agrif_InitValues_cont
86# endif       
87# if defined key_top
88      CALL Agrif_InitValues_cont_top
89# endif     
90   END SUBROUTINE Agrif_initvalues
91
92# if ! defined key_offline
93
94   SUBROUTINE Agrif_InitValues_cont
95      !!----------------------------------------------------------------------
96      !!                 *** ROUTINE Agrif_InitValues_cont ***
97      !!
98      !! ** Purpose ::   Declaration of variables to be interpolated
99      !!----------------------------------------------------------------------
100      USE Agrif_Util
101      USE oce 
102      USE dom_oce
103      USE nemogcm
104      USE sol_oce
105      USE in_out_manager
106      USE agrif_opa_update
107      USE agrif_opa_interp
108      USE agrif_opa_sponge
109      !
110      IMPLICIT NONE
111      !
112      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp
113      LOGICAL :: check_namelist
114      !!----------------------------------------------------------------------
115
116      ALLOCATE( tabtemp(jpi,jpj,jpk) )
117     
118     
119      ! 1. Declaration of the type of variable which have to be interpolated
120      !---------------------------------------------------------------------
121      CALL agrif_declare_var
122
123      ! 2. First interpolations of potentially non zero fields
124      !-------------------------------------------------------
125      Agrif_SpecialValue=0.
126      Agrif_UseSpecialValue = .TRUE.
127      Call Agrif_Bc_variable(tabtemp,tn_id,calledweight=1.,procname=interptn)
128   
129      Call Agrif_Bc_variable(tabtemp,sn_id,calledweight=1.,procname=interpsn)
130      Call Agrif_Bc_variable(tabtemp,un_id,calledweight=1.,procname=interpu)
131      Call Agrif_Bc_variable(tabtemp,vn_id,calledweight=1.,procname=interpv)
132
133      Call Agrif_Bc_variable(tabtemp,ta_id,calledweight=1.,procname=interptn)
134      Call Agrif_Bc_variable(tabtemp,sa_id,calledweight=1.,procname=interpsn)
135
136      Call Agrif_Bc_variable(tabtemp,ua_id,calledweight=1.,procname=interpun)
137      Call Agrif_Bc_variable(tabtemp,va_id,calledweight=1.,procname=interpvn)
138      Agrif_UseSpecialValue = .FALSE.
139
140      ! 3. Some controls
141      !-----------------
142      check_namelist = .true.
143           
144      IF( check_namelist ) THEN
145     
146         ! Check time steps           
147         IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
148            WRITE(*,*) 'incompatible time step between grids'
149            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
150            WRITE(*,*) 'child  grid value : ',nint(rdt)
151            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
152            STOP
153         ENDIF
154         
155         ! Check run length
156         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN
157            WRITE(*,*) 'incompatible run length between grids'
158            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step'
159            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step'
160            WRITE(*,*) 'value on child grid should be: ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1)
161            STOP
162         ENDIF
163         
164         ! Check coordinates
165         IF( ln_zps ) THEN
166            ! check parameters for partial steps
167            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
168               WRITE(*,*) 'incompatible e3zps_min between grids'
169               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
170               WRITE(*,*) 'child grid  :',e3zps_min
171               WRITE(*,*) 'those values should be identical'
172               STOP
173            ENDIF         
174            IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
175               WRITE(*,*) 'incompatible e3zps_rat between grids'
176               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
177               WRITE(*,*) 'child grid  :',e3zps_rat
178               WRITE(*,*) 'those values should be identical'                 
179               STOP
180            ENDIF
181         ENDIF
182      ENDIF
183       
184      CALL Agrif_Update_tra(0)
185      CALL Agrif_Update_dyn(0)
186
187      nbcline = 0
188      !
189      DEALLOCATE(tabtemp)
190      !
191   END SUBROUTINE Agrif_InitValues_cont
192
193
194   SUBROUTINE agrif_declare_var
195      !!----------------------------------------------------------------------
196      !!                 *** ROUTINE agrif_declarE_var ***
197      !!
198      !! ** Purpose :: Declaration of variables to be interpolated
199      !!----------------------------------------------------------------------
200      USE agrif_util
201      USE oce
202      IMPLICIT NONE
203      !!----------------------------------------------------------------------
204   
205      ! 1. Declaration of the type of variable which have to be interpolated
206      !---------------------------------------------------------------------
207      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id)
208      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id)
209      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id)
210      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id)
211      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id)
212      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id)
213         
214      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
215      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
216      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
217      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
218   
219      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
220      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
221
222      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
223      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
224       
225      ! 2. Type of interpolation
226      !-------------------------
227      CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear)
228      CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear)
229      CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear)
230      CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear)
231   
232      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
233      Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
234
235      Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
236      Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
237
238      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
239      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
240
241      ! 3. Location of interpolation
242      !-----------------------------
243      Call Agrif_Set_bc(un_id,(/0,1/))
244      Call Agrif_Set_bc(vn_id,(/0,1/))
245
246      Call Agrif_Set_bc(e1u_id,(/0,0/))
247      Call Agrif_Set_bc(e2v_id,(/0,0/))
248
249      Call Agrif_Set_bc(tn_id,(/0,1/))
250      Call Agrif_Set_bc(sn_id,(/0,1/))
251
252      Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/))
253      Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/))
254
255      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
256      Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
257
258      ! 5. Update type
259      !---------------
260      Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average)
261      Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average)
262
263      Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average)
264      Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average)
265
266      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
267      Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
268
269      Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
270      Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
271
272      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
273      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
274
275   END SUBROUTINE agrif_declare_var
276# endif
277   
278# if defined key_top
279   SUBROUTINE Agrif_InitValues_cont_top
280      !!----------------------------------------------------------------------
281      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
282      !!
283      !! ** Purpose :: Declaration of variables to be interpolated
284      !!----------------------------------------------------------------------
285      USE Agrif_Util
286      USE oce 
287      USE dom_oce
288      USE nemogcm
289      USE trc
290      USE in_out_manager
291      USE agrif_top_update
292      USE agrif_top_interp
293      USE agrif_top_sponge
294      !
295      IMPLICIT NONE
296      !
297      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
298      LOGICAL :: check_namelist
299      !!----------------------------------------------------------------------
300
301      ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
302     
303     
304      ! 1. Declaration of the type of variable which have to be interpolated
305      !---------------------------------------------------------------------
306      CALL agrif_declare_var_top
307
308      ! 2. First interpolations of potentially non zero fields
309      !-------------------------------------------------------
310      Agrif_SpecialValue=0.
311      Agrif_UseSpecialValue = .TRUE.
312      Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.)
313      Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
314      Agrif_UseSpecialValue = .FALSE.
315
316      ! 3. Some controls
317      !-----------------
318      check_namelist = .true.
319           
320      IF( check_namelist ) THEN
321#  if defined offline     
322         ! Check time steps           
323         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
324            WRITE(*,*) 'incompatible time step between grids'
325            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
326            WRITE(*,*) 'child  grid value : ',nint(rdt)
327            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
328            STOP
329         ENDIF
330         
331         ! Check run length
332         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
333            WRITE(*,*) 'incompatible run length between grids'
334            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step'
335            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step'
336            WRITE(*,*) 'value on child grid should be : ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1)
337            STOP
338         ENDIF
339         
340         ! Check coordinates
341         IF( ln_zps ) THEN
342            ! check parameters for partial steps
343            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
344               WRITE(*,*) 'incompatible e3zps_min between grids'
345               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
346               WRITE(*,*) 'child grid  :',e3zps_min
347               WRITE(*,*) 'those values should be identical'
348               STOP
349            ENDIF         
350            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
351               WRITE(*,*) 'incompatible e3zps_rat between grids'
352               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
353               WRITE(*,*) 'child grid  :',e3zps_rat
354               WRITE(*,*) 'those values should be identical'                 
355               STOP
356            ENDIF
357         ENDIF
358#  endif         
359        ! Check passive tracer cell
360        IF( nn_dttrc .ne. 1 ) THEN
361           WRITE(*,*) 'nn_dttrc should be equal to 1'
362        ENDIF
363      ENDIF
364       
365      CALL Agrif_Update_trc(0)
366      nbcline_trc = 0
367      !
368      DEALLOCATE(tabtrtemp)
369      !
370   END SUBROUTINE Agrif_InitValues_cont_top
371
372
373   SUBROUTINE agrif_declare_var_top
374      !!----------------------------------------------------------------------
375      !!                 *** ROUTINE agrif_declare_var_top ***
376      !!
377      !! ** Purpose :: Declaration of TOP variables to be interpolated
378      !!----------------------------------------------------------------------
379      USE agrif_util
380      USE dom_oce
381      USE trc
382     
383      IMPLICIT NONE
384   
385      ! 1. Declaration of the type of variable which have to be interpolated
386      !---------------------------------------------------------------------
387      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  &
388      &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
389      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  &
390      &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
391      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/),  &
392      &                           (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id)
393           
394#  if defined key_offline
395      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
396      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
397#  endif
398       
399      ! 2. Type of interpolation
400      !-------------------------
401      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
402      CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
403   
404#  if defined key_offline
405      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
406      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
407#  endif
408
409      ! 3. Location of interpolation
410      !-----------------------------
411#  if defined key_offline
412      Call Agrif_Set_bc(e1u_id,(/0,0/))
413      Call Agrif_Set_bc(e2v_id,(/0,0/))
414#  endif
415      Call Agrif_Set_bc(trn_id,(/0,1/))
416      Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
417
418      ! 5. Update type
419      !---------------
420      Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
421      Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
422
423#  if defined key_offline
424      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
425      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
426#  endif
427
428   END SUBROUTINE agrif_declare_var_top
429# endif
430   
431   SUBROUTINE Agrif_detect( kg, ksizex )
432      !!----------------------------------------------------------------------
433      !!   *** ROUTINE Agrif_detect ***
434      !!----------------------------------------------------------------------
435      USE Agrif_Types
436      !
437      INTEGER, DIMENSION(2) :: ksizex
438      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
439      !!----------------------------------------------------------------------
440      !
441      RETURN
442      !
443   END SUBROUTINE Agrif_detect
444
445
446   SUBROUTINE agrif_nemo_init
447      !!----------------------------------------------------------------------
448      !!                     *** ROUTINE agrif_init ***
449      !!----------------------------------------------------------------------
450      USE agrif_oce 
451      USE in_out_manager
452      USE lib_mpp
453      IMPLICIT NONE
454      !
455      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
456      !!----------------------------------------------------------------------
457      !
458      REWIND( numnam )                ! Read namagrif namelist
459      READ  ( numnam, namagrif )
460      !
461      IF(lwp) THEN                    ! control print
462         WRITE(numout,*)
463         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
464         WRITE(numout,*) '~~~~~~~~~~~~~~~'
465         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
466         WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
467         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
468         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
469         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
470         WRITE(numout,*) 
471      ENDIF
472      !
473      ! convert DOCTOR namelist name into OLD names
474      nbclineupdate = nn_cln_update
475      visc_tra      = rn_sponge_tra
476      visc_dyn      = rn_sponge_dyn
477      !
478      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
479      !
480    END SUBROUTINE agrif_nemo_init
481
482# if defined key_mpp_mpi
483
484   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
485      !!----------------------------------------------------------------------
486      !!                     *** ROUTINE Agrif_detect ***
487      !!----------------------------------------------------------------------
488      USE dom_oce
489      IMPLICIT NONE
490      !
491      INTEGER :: indglob, indloc, nprocloc, i
492      !!----------------------------------------------------------------------
493      !
494      SELECT CASE( i )
495      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
496      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
497      CASE(3)   ;   indglob = indloc
498      CASE(4)   ;   indglob = indloc
499      END SELECT
500      !
501   END SUBROUTINE Agrif_InvLoc
502
503# endif
504
505#else
506   SUBROUTINE Subcalledbyagrif
507      !!----------------------------------------------------------------------
508      !!                   *** ROUTINE Subcalledbyagrif ***
509      !!----------------------------------------------------------------------
510      WRITE(*,*) 'Impossible to be here'
511   END SUBROUTINE Subcalledbyagrif
512#endif
Note: See TracBrowser for help on using the repository browser.