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.
crs.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90 @ 5010

Last change on this file since 5010 was 5010, checked in by cbricaud, 8 years ago

second modifications for output coarsening . see ticket 1426
File size: 19.4 KB
Line 
1MODULE crs   
2   !!======================================================================
3   !!                         ***  MODULE crs_dom  ***
4   !!        Declare the coarse grid domain and other public variables
5   !!        then allocate them if needed.
6   !!======================================================================
7   !!  History     2012-06  Editing  (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
8   !!----------------------------------------------------------------------
9   USE par_oce 
10   USE dom_oce
11   USE in_out_manager
12   USE lbcnfd
13
14   IMPLICIT NONE
15   PUBLIC
16
17   
18   PUBLIC crs_dom_alloc  ! Called from crsini.F90
19   PUBLIC crs_dom_alloc1  ! Called from crsini.F90
20   PUBLIC crs_dom_alloc2  ! Called from crsini.F90
21   PUBLIC dom_grid_glo   
22   PUBLIC dom_grid_crs 
23
24      ! Domain variables
25      INTEGER  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
26                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
27      INTEGER  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
28                   jpj_crs                      !: 2nd dimension of local coarse grid domain
29      INTEGER  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
30                   jpj_full                     !: 2nd dimension of local parent grid domain
31
32      INTEGER  ::  nistr , njstr
33      INTEGER  ::  niend , njend
34
35      INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices     
36      INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices     
37      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
38      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
39      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
40      INTEGER  ::  npiglo, npjglo               !: jpjglo
41      INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
42      INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
43      INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
44      INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
45      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
46      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
47
48      INTEGER  ::  narea_full, narea_crs        !: node
49      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
50      INTEGER  ::  jpim1_full, jpjm1_full       !:
51      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
52      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
53      INTEGER  ::  nreci_full, nrecj_full
54      INTEGER  ::  nreci_crs, nrecj_crs
55      !cc
56      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in
57      INTEGER ::   noso_full, nono_full        !: east, west, south and north directions
58      INTEGER ::   npne_full, npnw_full        !: index of north east and north west processor
59      INTEGER ::   npse_full, npsw_full        !: index of south east and south west processor
60      INTEGER ::   nbne_full, nbnw_full        !: logical of north east & north west processor
61      INTEGER ::   nbse_full, nbsw_full        !: logical of south east & south west processor
62      INTEGER ::   nidom_full                  !: ???
63      INTEGER ::   nproc_full                  !:number for local processor
64      INTEGER ::   nbondi_full, nbondj_full    !: mark of i- and j-direction local boundaries
65      INTEGER ::   noea_crs, nowe_crs          !: index of the local neighboring processors in
66      INTEGER ::   noso_crs, nono_crs          !: east, west, south and north directions
67      INTEGER ::   npne_crs, npnw_crs          !: index of north east and north west processor
68      INTEGER ::   npse_crs, npsw_crs          !: index of south east and south west processor
69      INTEGER ::   nbne_crs, nbnw_crs          !: logical of north east & north west processor
70      INTEGER ::   nbse_crs, nbsw_crs          !: logical of south east & south west processor
71      INTEGER ::   nidom_crs                   !: ???
72      INTEGER ::   nproc_crs                   !:number for local processor
73      INTEGER ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
74     
75      INTEGER ::  nfsloop_full,nfeloop_full 
76      INTEGER ::  nfsloop_crs ,nfeloop_crs
77
78      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
79      INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset
80      INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
81      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
82      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box
83      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain
84      INTEGER, DIMENSION(:), ALLOCATABLE ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain
85      INTEGER, DIMENSION(:), ALLOCATABLE ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain
86      INTEGER, DIMENSION(:), ALLOCATABLE ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain
87      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain
88      INTEGER, DIMENSION(:), ALLOCATABLE ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain
89      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain
90      INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain
91
92      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_full
93      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_crs
94 
95      ! Masks
96      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
97      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
98     
99  !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol     
100
101      ! Scale factors
102      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
103      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
104      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
105      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
106      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
107      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs
108     
109      ! Surface
110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs
111      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk
112                                                                  ! vertical scale factors
113      ! Coordinates
114      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
115      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
116      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs
117      INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
118      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
119
120      ! Weights
121      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
122      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
123      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
124
125      ! CRS Namelist
126      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
127      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
128      INTEGER           :: nn_binref  = 0       !: 0 = binning starts north fold (equator could be asymmetric)
129                                                !: 1 = binning centers at equator (north fold my have artifacts)     
130                                                !:    for even reduction factors, equator placed in bin biased south
131      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output
132                                                !: 0 = no mesh mask output
133                                                !: 1 = unified mesh mask output
134                                                !: 2 = 2 separate mesh mask output
135                                                !: 3 = 3 separate mesh mask output
136      INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)
137      LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence
138      !
139      INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor
140
141
142      ! Grid reduction factors
143      REAL(wp)     ::  rfactx_r                !: inverse of x-dim reduction factor
144      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor
145      REAL(wp)     ::  rfactxy 
146
147      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
148      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
149      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
150      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs   
151      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs   
152      !
153      ! Surface fluxes to pass to TOP
154      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs
155      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs
156      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs
157      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs
158
159      ! Vertical diffusion
160      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp 
161# if defined key_zdfddm
162      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
163# endif
164
165      ! Mixing and Mixed Layer Depth
166      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
167
168      ! Direction of lateral diffusion
169
170
171CONTAINS
172   
173   INTEGER FUNCTION crs_dom_alloc1()
174      !!-------------------------------------------------------------------
175      !!                     *** FUNCTION crs_dom_alloc ***
176      !!  ** Purpose :   Allocate public crs arrays 
177      !!-------------------------------------------------------------------
178      !! Local variables
179      INTEGER, DIMENSION(14) :: ierr
180
181      ierr(:) = 0
182
183      ! Set up bins for coarse grid, horizontal only.
184     ALLOCATE( mis2_crs(jpiglo_crs), mie2_crs(jpiglo_crs),  &
185       &       mjs2_crs(jpjglo_crs), mje2_crs(jpjglo_crs),  &
186       &       mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs),  &
187       &       mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs),  &
188       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  STAT=ierr(1) ) 
189
190
191      ! Set up Mask and Mesh
192      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
193         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
194
195      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs)   , rnfmsk_crs(jpi_crs,jpj_crs), &
196      &         tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) )
197
198      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
199         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
200         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
201         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
202         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
203
204      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
205         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
206         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
207         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
208         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
209
210      ALLOCATE( e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)    , & 
211         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)    , &
212         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , e1e2w_msk(jpi_crs,jpj_crs,jpk)  , & 
213         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk)  , &
214         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)  , &
215         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , e3t_max_crs(jpi_crs,jpj_crs,jpk), &
216         &      e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk), &
217         &      e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6))
218
219
220      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk), facsurfu(jpi_crs,jpj_crs,jpk) , & 
221         &      facvol_t(jpi_crs,jpj_crs,jpk), facvol_w(jpi_crs,jpj_crs,jpk) , &
222         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk), ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
223         &      bt_crs(jpi_crs,jpj_crs,jpk)  , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
224
225
226      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk), crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
227         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk), crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
228
229
230      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs), mbkt_crs(jpi_crs,jpj_crs) , &
231         &      mbku_crs(jpi_crs,jpj_crs)  , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
232
233      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk), gdepu_crs(jpi_crs,jpj_crs,jpk) , &
234         &      gdepv_crs(jpi_crs,jpj_crs,jpk), gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
235
236
237      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
238         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),&
239         &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11))
240
241     ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
242         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
243         &     vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), &
244         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
245
246     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
247# if defined key_zdfddm
248         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
249# endif
250         &      STAT=ierr(13) )
251
252      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
253         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
254
255      crs_dom_alloc1 = MAXVAL(ierr)
256
257   END FUNCTION crs_dom_alloc1
258
259   INTEGER FUNCTION crs_dom_alloc()
260      !!-------------------------------------------------------------------
261      !!                     *** FUNCTION crs_dom_alloc ***
262      !!  ** Purpose :   Allocate public crs arrays 
263      !!-------------------------------------------------------------------
264      !! Local variables
265      INTEGER, DIMENSION(2) :: ierr
266
267      ierr(:) = 0
268         
269      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
270       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
271                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
272       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(1) )
273
274      ALLOCATE( nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) ,STAT=ierr(2) )
275
276      crs_dom_alloc = MAXVAL(ierr)
277
278   END FUNCTION crs_dom_alloc
279   
280   INTEGER FUNCTION crs_dom_alloc2()
281      !!-------------------------------------------------------------------
282      !!                     *** FUNCTION crs_dom_alloc ***
283      !!  ** Purpose :   Allocate public crs arrays 
284      !!-------------------------------------------------------------------
285      !! Local variables
286      INTEGER, DIMENSION(1) :: ierr
287
288      ierr(:) = 0
289     
290      !cbr ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) )
291      !cbr pk on alloue ac nlej_crs ??????
292      !cbrALLOCATE( mjs_crs(nlcj_crs) , mje_crs(nlcj_crs), mis_crs(nlci_crs) , mie_crs(nlci_crs), STAT=ierr(1) )
293      ALLOCATE( mjs_crs(jpj_crs) , mje_crs(jpj_crs), mis_crs(jpi_crs) , mie_crs(jpi_crs), STAT=ierr(1) )
294      crs_dom_alloc2 = MAXVAL(ierr)
295
296      END FUNCTION crs_dom_alloc2
297
298   SUBROUTINE dom_grid_glo
299      !!--------------------------------------------------------------------
300      !!                       ***  MODULE dom_grid_glo  ***
301      !!
302      !! ** Purpose : +Return back to parent grid domain
303      !!---------------------------------------------------------------------
304      write(narea+200,*)"dom_grid_glo";call flush(narea+200)
305
306      !                         Return to parent grid domain
307      jpi    = jpi_full
308      jpj    = jpj_full
309      jpim1  = jpim1_full
310      jpjm1  = jpjm1_full
311      nperio = nperio_full
312
313      npolj  = npolj_full
314      jpiglo = jpiglo_full
315      jpjglo = jpjglo_full
316
317      nlci   = nlci_full
318      nlcj   = nlcj_full
319      nldi   = nldi_full
320      nldj   = nldj_full
321      nlei   = nlei_full
322      nlej   = nlej_full
323      nimpp  = nimpp_full
324      njmpp  = njmpp_full
325     
326      nlcit(:)  = nlcit_full(:)
327      nldit(:)  = nldit_full(:)
328      nleit(:)  = nleit_full(:)
329      nimppt(:) = nimppt_full(:)
330      nlcjt(:)  = nlcjt_full(:)
331      nldjt(:)  = nldjt_full(:)
332      nlejt(:)  = nlejt_full(:)
333      njmppt(:) = njmppt_full(:)
334
335      nfsloop = nfsloop_full
336      nfeloop = nfeloop_full
337
338      nfiimpp(:,:) = nfiimpp_full(:,:)
339
340   END SUBROUTINE dom_grid_glo
341
342   SUBROUTINE dom_grid_crs
343      !!--------------------------------------------------------------------
344      !!                       ***  MODULE dom_grid_crs  ***
345      !!
346      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
347      !!---------------------------------------------------------------------
348      write(narea+200,*)"dom_grid_crs";call flush(narea+200)
349      !
350      !                        Switch to coarse grid domain
351      jpi    = jpi_crs
352      jpj    = jpj_crs
353      jpim1  = jpi_crsm1
354      jpjm1  = jpj_crsm1
355      nperio = nperio_crs
356
357      npolj  = npolj_crs
358      jpiglo = jpiglo_crs
359      jpjglo = jpjglo_crs
360
361
362      nlci   = nlci_crs
363      nlcj   = nlcj_crs
364      nldi   = nldi_crs
365      nlei   = nlei_crs
366      nlej   = nlej_crs
367      nldj   = nldj_crs
368      nimpp  = nimpp_crs
369      njmpp  = njmpp_crs
370     
371      nlcit(:)  = nlcit_crs(:)
372      nldit(:)  = nldit_crs(:)
373      nleit(:)  = nleit_crs(:)
374      nimppt(:) = nimppt_crs(:)
375      nlcjt(:)  = nlcjt_crs(:)
376      nldjt(:)  = nldjt_crs(:)
377      nlejt(:)  = nlejt_crs(:)
378      njmppt(:) = njmppt_crs(:)
379
380      nfsloop = nfsloop_crs
381      nfeloop = nfeloop_crs
382
383      nfiimpp(:,:) = nfiimpp_crs(:,:)
384
385      !
386   END SUBROUTINE dom_grid_crs
387   
388     
389   !!======================================================================
390
391END MODULE crs
392
Note: See TracBrowser for help on using the repository browser.