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

Context Navigation

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

Last change on this file since 7210 was 7210, checked in by cbricaud, 7 years ago
commit modification in CRS branch
Property svn:keywords set to `Id`
File size: 23.5 KB

Line
1	MODULE 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 par_trc
11	USE dom_oce
12	USE in_out_manager
13	USE lbcnfd
14
15	IMPLICIT NONE
16	PUBLIC
17
18
19	PUBLIC crs_dom_alloc ! Called from crsini.F90
20	PUBLIC dom_grid_glo
21	PUBLIC dom_grid_crs
22
23	! Domain variables
24	INTEGER :: jpiglo_crs , & !: 1st dimension of global coarse grid domain
25	jpjglo_crs !: 2nd dimension of global coarse grid domain
26	INTEGER :: jpi_crs , & !: 1st dimension of local coarse grid domain
27	jpj_crs !: 2nd dimension of local coarse grid domain
28	INTEGER :: jpi_full , & !: 1st dimension of local parent grid domain
29	jpj_full !: 2nd dimension of local parent grid domain
30
31	INTEGER :: nistr , njstr
32	INTEGER :: niend , njend
33
34	INTEGER :: jpi_crsm1, jpj_crsm1 !: loop indices
35	INTEGER :: jpiglo_crsm1, jpjglo_crsm1 !: loop indices
36	INTEGER :: nperio_full, nperio_crs !: jperio of parent and coarse grids
37	INTEGER :: npolj_full, npolj_crs !: north fold mark
38	INTEGER :: jpiglo_full, jpjglo_full !: jpiglo / jpjglo
39	INTEGER :: npiglo, npjglo !: jpjglo
40	INTEGER :: nlci_full, nlcj_full !: i-, j-dimension of local or sub domain on parent grid
41	INTEGER :: nldi_full, nldj_full !: starting indices of internal sub-domain on parent grid
42	INTEGER :: nlei_full, nlej_full !: ending indices of internal sub-domain on parent grid
43	INTEGER :: nlci_crs, nlcj_crs !: i-, j-dimension of local or sub domain on coarse grid
44	INTEGER :: nldi_crs, nldj_crs !: starting indices of internal sub-domain on coarse grid
45	INTEGER :: nlei_crs, nlej_crs !: ending indices of internal sub-domain on coarse grid
46
47	INTEGER :: narea_full, narea_crs !: node
48	INTEGER :: jpnij_full, jpnij_crs !: =jpni*jpnj, the pe decomposition
49	INTEGER :: jpim1_full, jpjm1_full !:
50	INTEGER :: nimpp_full, njmpp_full !: global position of point (1,1) of subdomain on parent grid
51	INTEGER :: nimpp_crs, njmpp_crs !: set to 1,1 for now . Valid only for monoproc
52	INTEGER :: nreci_full, nrecj_full
53	INTEGER :: nreci_crs, nrecj_crs
54	!cc
55	INTEGER :: noea_full, nowe_full !: index of the local neighboring processors in
56	INTEGER :: noso_full, nono_full !: east, west, south and north directions
57	INTEGER :: npne_full, npnw_full !: index of north east and north west processor
58	INTEGER :: npse_full, npsw_full !: index of south east and south west processor
59	INTEGER :: nbne_full, nbnw_full !: logical of north east & north west processor
60	INTEGER :: nbse_full, nbsw_full !: logical of south east & south west processor
61	INTEGER :: nidom_full !: ???
62	INTEGER :: nproc_full !:number for local processor
63	INTEGER :: nbondi_full, nbondj_full !: mark of i- and j-direction local boundaries
64	INTEGER :: noea_crs, nowe_crs !: index of the local neighboring processors in
65	INTEGER :: noso_crs, nono_crs !: east, west, south and north directions
66	INTEGER :: npne_crs, npnw_crs !: index of north east and north west processor
67	INTEGER :: npse_crs, npsw_crs !: index of south east and south west processor
68	INTEGER :: nbne_crs, nbnw_crs !: logical of north east & north west processor
69	INTEGER :: nbse_crs, nbsw_crs !: logical of south east & south west processor
70	INTEGER :: nidom_crs !: ???
71	INTEGER :: nproc_crs !:number for local processor
72	INTEGER :: nbondi_crs, nbondj_crs !: mark of i- and j-direction local boundaries
73
74	INTEGER :: nfsloop_full,nfeloop_full
75	INTEGER :: nfsloop_crs ,nfeloop_crs
76
77	INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs ! starting and ending i-indices of parent subset
78	INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending j-indices of parent subset
79	INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
80	INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
81	INTEGER :: mxbinctr, mybinctr ! central point in grid box
82	INTEGER, DIMENSION(:), ALLOCATABLE :: nlcit_crs, nlcit_full !: dimensions of every subdomain
83	INTEGER, DIMENSION(:), ALLOCATABLE :: nldit_crs, nldit_full !: first, last indoor index for each i-domain
84	INTEGER, DIMENSION(:), ALLOCATABLE :: nleit_crs, nleit_full !: first, last indoor index for each j-domain
85	INTEGER, DIMENSION(:), ALLOCATABLE :: nimppt_crs, nimppt_full !: first, last indoor index for each j-domain
86	INTEGER, DIMENSION(:), ALLOCATABLE :: nlcjt_crs, nlcjt_full !: dimensions of every subdomain
87	INTEGER, DIMENSION(:), ALLOCATABLE :: nldjt_crs, nldjt_full !: first, last indoor index for each i-domain
88	INTEGER, DIMENSION(:), ALLOCATABLE :: nlejt_crs, nlejt_full !: first, last indoor index for each j-domain
89	INTEGER, DIMENSION(:), ALLOCATABLE :: njmppt_crs, njmppt_full !: first, last indoor index for each j-domain
90
91	INTEGER, DIMENSION(:,:), ALLOCATABLE :: nfiimpp_full
92	INTEGER, DIMENSION(:,:), ALLOCATABLE :: nfiimpp_crs
93
94	! Masks
95	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
96	REAL(wp), DIMENSION(:,:) , ALLOCATABLE,SAVE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
97
98	! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmask_i_crs, tpol, fpol
99
100	! Scale factors
101	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
102	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
103	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
104	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
105
106	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ht_0_crs
107	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_0_crs, e3u_0_crs, e3v_0_crs, e3f_0_crs, e3w_0_crs
108	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_0_crs, e3u_max_0_crs, e3v_max_0_crs, e3f_max_0_crs, e3w_max_0_crs
109
110	#if defined key_vvl
111	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_b_crs, e3u_b_crs, e3v_b_crs, e3f_b_crs, e3w_b_crs
112	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_n_crs, e3u_n_crs, e3v_n_crs, e3f_n_crs, e3w_n_crs
113	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_a_crs, e3u_a_crs, e3v_a_crs, e3f_a_crs, e3w_a_crs
114
115	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_n_crs, e3u_max_n_crs, e3v_max_n_crs, e3f_max_n_crs, e3w_max_n_crs
116	#endif
117
118
119	! Surface
120	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs
121	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk
122	! vertical scale factors
123	! Coordinates
124	REAL(wp), DIMENSION(:,:), ALLOCATABLE,SAVE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs
125	REAL(wp), DIMENSION(:,:), ALLOCATABLE,SAVE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs
126	REAL(wp), DIMENSION(:,:), ALLOCATABLE,SAVE :: ff_crs
127	INTEGER, DIMENSION(:,:), ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
128
129	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_0_crs, gdepu_0_crs, gdepv_0_crs, gdepw_0_crs
130	#if defined key_vvl
131	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_n_crs, gdepu_n_crs, gdepv_n_crs, gdepw_n_crs
132	#endif
133
134	! Weights
135	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
136	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
137	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
138
139	! CRS Namelist
140	INTEGER :: nn_factx = 3 !: reduction factor of x-dimension of the parent grid
141	INTEGER :: nn_facty = 3 !: reduction factor of y-dimension of the parent grid
142	INTEGER :: nn_binref = 0 !: 0 = binning starts north fold (equator could be asymmetric)
143	!: 1 = binning centers at equator (north fold my have artifacts)
144	!: for even reduction factors, equator placed in bin biased south
145	INTEGER :: nn_msh_crs = 1 !: Organization of mesh mask output
146	!: 0 = no mesh mask output
147	!: 1 = unified mesh mask output
148	!: 2 = 2 separate mesh mask output
149	!: 3 = 3 separate mesh mask output
150	INTEGER :: nn_crs_kz = 0 !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)
151	LOGICAL :: ln_crs_wn = .FALSE. !: coarsening wn or computation using horizontal divergence
152	LOGICAL, PUBLIC :: ln_crs_top = .FALSE. !:coarsening online for the bio
153	!
154	INTEGER :: nrestx, nresty !: for determining odd or even reduction factor
155
156
157	! Grid reduction factors
158	REAL(wp) :: rfactx_r !: inverse of x-dim reduction factor
159	REAL(wp) :: rfacty_r !: inverse of y-dim reduction factor
160	REAL(wp) :: rfactxy
161
162	INTEGER, DIMENSION(:) , ALLOCATABLE :: nfactx,nfacty
163
164
165	! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
166	REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tsb_crs,tsn_crs,tsa_crs,rab_crs_n
167	REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: un_crs, vn_crs, wn_crs, rke_crs
168	REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ub_crs, vb_crs
169	REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: hdivb_crs , hdivn_crs
170	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: sshb_crs, sshn_crs , ssha_crs
171	REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: rhop_crs,rhd_crs,rn2_crs,rb2_crs
172	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: gru_crs, grv_crs
173	REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: gtsu_crs, gtsv_crs
174	!
175	! Surface fluxes to pass to TOP
176	REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs,qsr_mean_crs
177	REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs
178	REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: fmmflx_crs
179	REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs
180	REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: rnf_crs,rnf_b_crs,h_rnf_crs
181	INTEGER , PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: nk_rnf_crs
182	REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_i_crs,trc_o_crs
183
184	REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: etot3_crs
185	REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: uslp_crs, wslpi_crs !: i_slope at U- and W-points
186	REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: vslp_crs, wslpj_crs !: j-slope at V- and W-points
187
188	! Horizontal diffusion
189	#if defined key_traldf_c3d
190	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs !: 3D coefficients at T-,U-,V-,W-points
191	#elif defined key_traldf_c2d
192	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs !: 2D coefficients at T-,U-,V-,W-points
193	#elif defined key_traldf_c1d
194	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs !: 1D coefficients at T-,U-,V-,W-points
195	#else
196	REAL(wp), PUBLIC :: ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs !: 0D coefficients at T-,U-,V-,W-points
197	#endif
198
199	! Vertical diffusion
200	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avt_crs !: vert. diffusivity coef. [m2/s] at w-point for temp
201	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: en_crs !: vert. diffusivity coef. [m2/s] at w-point for temp
202	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: avtb_2d_crs !: vert. diffusivity coef. [m2/s] at w-point for temp
203	# if defined key_zdfddm
204	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avs_crs !: salinity vertical diffusivity coeff. [m2/s] at w-point
205	# endif
206
207	! Mixing and Mixed Layer Depth
208	INTEGER, PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: nmln_crs
209	REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: hmlp_crs , hmlpt_crs , hmld_crs
210
211	! Direction of lateral diffusion
212
213
214	!! $Id$
215	CONTAINS
216
217	INTEGER FUNCTION crs_dom_alloc()
218	!!-------------------------------------------------------------------
219	!! * FUNCTION crs_dom_alloc *
220	!! ** Purpose : Allocate public crs arrays
221	!!-------------------------------------------------------------------
222	!! Local variables
223	INTEGER, DIMENSION(15) :: ierr
224
225	ierr(:) = 0
226
227	! Set up bins for coarse grid, horizontal only.
228	ALLOCATE( mis2_crs(jpiglo_crs), mie2_crs(jpiglo_crs), &
229	& mjs2_crs(jpjglo_crs), mje2_crs(jpjglo_crs), &
230	& mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs), &
231	& mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs), &
232	& mig_crs (jpi_crs) , mjg_crs (jpj_crs) , &
233	& mis_crs (jpi_crs) , mie_crs (jpi_crs) , &
234	& mjs_crs (jpj_crs) , mje_crs (jpj_crs) , &
235	& nfactx (jpi_crs) , nfacty (jpj_crs) , &
236	& nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij) , &
237	& nimppt_full(jpnij), nlcit_full(jpnij), nldit_full(jpnij), nleit_full(jpnij), &
238	& njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij) , &
239	& njmppt_full(jpnij), nlcjt_full(jpnij), nldjt_full(jpnij), nlejt_full(jpnij), &
240	& nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) , STAT=ierr(1) )
241
242	! Set up Mask and Mesh
243	ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) , &
244	& umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
245
246	ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs) , rnfmsk_crs(jpi_crs,jpj_crs), &
247	& tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) )
248
249	ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , &
250	& gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
251	& gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
252	& gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
253	& ff_crs(jpi_crs,jpj_crs) , STAT=ierr(4))
254
255	ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , &
256	& e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , &
257	& e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
258	& e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
259	& e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
260
261	ALLOCATE( e3t_0_crs(jpi_crs,jpj_crs,jpk) , e3w_0_crs(jpi_crs,jpj_crs,jpk) , &
262	& e3u_0_crs(jpi_crs,jpj_crs,jpk) , e3v_0_crs(jpi_crs,jpj_crs,jpk) , &
263	& ht_0_crs(jpi_crs,jpj_crs), &
264	#if defined key_vvl
265	& e3t_b_crs(jpi_crs,jpj_crs,jpk) , e3w_b_crs(jpi_crs,jpj_crs,jpk) , &
266	& e3u_b_crs(jpi_crs,jpj_crs,jpk) , e3v_b_crs(jpi_crs,jpj_crs,jpk) , &
267	& e3t_n_crs(jpi_crs,jpj_crs,jpk) , e3w_n_crs(jpi_crs,jpj_crs,jpk) , &
268	& e3u_n_crs(jpi_crs,jpj_crs,jpk) , e3v_n_crs(jpi_crs,jpj_crs,jpk) , &
269	& e3t_a_crs(jpi_crs,jpj_crs,jpk) , e3w_a_crs(jpi_crs,jpj_crs,jpk) , &
270	& e3u_a_crs(jpi_crs,jpj_crs,jpk) , e3v_a_crs(jpi_crs,jpj_crs,jpk) , &
271	#endif
272	& e1e2w_msk(jpi_crs,jpj_crs,jpk) , &
273	& e2e3u_msk(jpi_crs,jpj_crs,jpk) , e1e3v_msk(jpi_crs,jpj_crs,jpk) , &
274	& e1e2w_crs(jpi_crs,jpj_crs,jpk) , e2e3u_crs(jpi_crs,jpj_crs,jpk) , &
275	& e1e3v_crs(jpi_crs,jpj_crs,jpk) , &
276	& e3t_max_0_crs(jpi_crs,jpj_crs,jpk), e3w_max_0_crs(jpi_crs,jpj_crs,jpk) , &
277	& e3u_max_0_crs(jpi_crs,jpj_crs,jpk), e3v_max_0_crs(jpi_crs,jpj_crs,jpk) , &
278	#if defined key_vvl
279	& e3t_max_n_crs(jpi_crs,jpj_crs,jpk), e3w_max_n_crs(jpi_crs,jpj_crs,jpk) , &
280	& e3u_max_n_crs(jpi_crs,jpj_crs,jpk), e3v_max_n_crs(jpi_crs,jpj_crs,jpk) , &
281	#endif
282	& STAT=ierr(6))
283
284
285	ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk), facsurfu(jpi_crs,jpj_crs,jpk) , &
286	& facvol_t(jpi_crs,jpj_crs,jpk), facvol_w(jpi_crs,jpj_crs,jpk) , &
287	& ocean_volume_crs_t(jpi_crs,jpj_crs,jpk), ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
288	& bt_crs(jpi_crs,jpj_crs,jpk) , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
289
290
291	ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk), crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , &
292	& crs_surfw_wgt(jpi_crs,jpj_crs,jpk), crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
293
294
295	ALLOCATE( mbathy_crs(jpi_crs,jpj_crs), mbkt_crs(jpi_crs,jpj_crs) , &
296	& mbku_crs(jpi_crs,jpj_crs) , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
297
298	ALLOCATE( gdept_0_crs(jpi_crs,jpj_crs,jpk), gdepu_0_crs(jpi_crs,jpj_crs,jpk) , &
299	& gdepv_0_crs(jpi_crs,jpj_crs,jpk), gdepw_0_crs(jpi_crs,jpj_crs,jpk) , &
300	#if defined key_vvl
301	& gdept_n_crs(jpi_crs,jpj_crs,jpk), gdepu_n_crs(jpi_crs,jpj_crs,jpk) , &
302	& gdepv_n_crs(jpi_crs,jpj_crs,jpk), gdepw_n_crs(jpi_crs,jpj_crs,jpk) , &
303	#endif
304	& STAT=ierr(10))
305
306
307	ALLOCATE( ub_crs(jpi_crs,jpj_crs,jpk) , vb_crs(jpi_crs,jpj_crs,jpk) , &
308	& un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , wn_crs(jpi_crs,jpj_crs,jpk) , &
309	& hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , &
310	& rke_crs(jpi_crs,jpj_crs,jpk), rhop_crs(jpi_crs,jpj_crs,jpk) , &
311	& rb2_crs(jpi_crs,jpj_crs,jpk) ,rn2_crs(jpi_crs,jpj_crs,jpk) , &
312	& rhd_crs(jpi_crs,jpj_crs,jpk) , rab_crs_n(jpi_crs,jpj_crs,jpk,jpts) , &
313	& avtb_2d_crs(jpi_crs,jpj_crs), &
314	& gtsu_crs(jpi_crs,jpj_crs,jpts) ,gtsv_crs(jpi_crs,jpj_crs,jpts) , &
315	gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11))
316
317	ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs), ssha_crs(jpi_crs,jpj_crs), &
318	& qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
319	& qsr_mean_crs(jpi_crs ,jpj_crs) , &
320	& vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs), &
321	& rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), &
322	& h_rnf_crs(jpi_crs,jpj_crs), nk_rnf_crs(jpi_crs ,jpj_crs), &
323	& emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
324	& etot3_crs(jpi_crs,jpj_crs,jpk) , &
325	& trc_i_crs (jpi_crs,jpj_crs,jptra), trc_o_crs(jpi_crs,jpj_crs,jptra), &
326	& fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) )
327
328	#if defined key_traldf_c3d
329	ALLOCATE( ahtt_crs(jpi_crs,jpj_crs,jpk) , ahtu_crs(jpi_crs,jpj_crs,jpk) , &
330	& ahtv_crs(jpi_crs,jpj_crs,jpk) , ahtw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(13) )
331	#elif defined key_traldf_c2d
332	ALLOCATE( ahtt_crs(jpi_crs,jpj_crs ) , ahtu_crs(jpi_crs,jpj_crs ) , &
333	& ahtv_crs(jpi_crs,jpj_crs ) , ahtw_crs(jpi_crs,jpj_crs ) , STAT=ierr(13) )
334	#elif defined key_traldf_c1d
335	ALLOCATE( ahtt_crs( jpk) , ahtu_crs( jpk) , ahtv_crs( jpk) , ahtw_crs( jpk) , STAT=ierr(13) )
336	#endif
337
338	ALLOCATE( tsb_crs(jpi_crs,jpj_crs,jpk,jpts), tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsa_crs(jpi_crs,jpj_crs,jpk,jpts), &
339	en_crs(jpi_crs,jpj_crs,jpk), avt_crs(jpi_crs,jpj_crs,jpk), &
340	# if defined key_zdfddm
341	& avs_crs(jpi_crs,jpj_crs,jpk), &
342	# endif
343	& STAT=ierr(14) )
344
345	ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
346	& hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(15) )
347
348	crs_dom_alloc = MAXVAL(ierr)
349
350	END FUNCTION crs_dom_alloc
351
352	SUBROUTINE dom_grid_glo
353	!!--------------------------------------------------------------------
354	!! * MODULE dom_grid_glo *
355	!!
356	!! ** Purpose : +Return back to parent grid domain
357	!!---------------------------------------------------------------------
358
359	! Return to parent grid domain
360	jpi = jpi_full
361	jpj = jpj_full
362	jpim1 = jpim1_full
363	jpjm1 = jpjm1_full
364	nperio = nperio_full
365
366	npolj = npolj_full
367	jpiglo = jpiglo_full
368	jpjglo = jpjglo_full
369
370	nlci = nlci_full
371	nlcj = nlcj_full
372	nldi = nldi_full
373	nldj = nldj_full
374	nlei = nlei_full
375	nlej = nlej_full
376	nimpp = nimpp_full
377	njmpp = njmpp_full
378
379	nlcit(:) = nlcit_full(:)
380	nldit(:) = nldit_full(:)
381	nleit(:) = nleit_full(:)
382	nimppt(:) = nimppt_full(:)
383	nlcjt(:) = nlcjt_full(:)
384	nldjt(:) = nldjt_full(:)
385	nlejt(:) = nlejt_full(:)
386	njmppt(:) = njmppt_full(:)
387
388	nfsloop = nfsloop_full
389	nfeloop = nfeloop_full
390
391	nfiimpp(:,:) = nfiimpp_full(:,:)
392
393	END SUBROUTINE dom_grid_glo
394
395	SUBROUTINE dom_grid_crs
396	!!--------------------------------------------------------------------
397	!! * MODULE dom_grid_crs *
398	!!
399	!! ** Purpose : Save the parent grid information & Switch to coarse grid domain
400	!!---------------------------------------------------------------------
401	!
402	! Switch to coarse grid domain
403	jpi = jpi_crs
404	jpj = jpj_crs
405	jpim1 = jpi_crsm1
406	jpjm1 = jpj_crsm1
407	nperio = nperio_crs
408
409	npolj = npolj_crs
410	jpiglo = jpiglo_crs
411	jpjglo = jpjglo_crs
412
413
414	nlci = nlci_crs
415	nlcj = nlcj_crs
416	nldi = nldi_crs
417	nlei = nlei_crs
418	nlej = nlej_crs
419	nldj = nldj_crs
420	nimpp = nimpp_crs
421	njmpp = njmpp_crs
422
423	nlcit(:) = nlcit_crs(:)
424	nldit(:) = nldit_crs(:)
425	nleit(:) = nleit_crs(:)
426	nimppt(:) = nimppt_crs(:)
427	nlcjt(:) = nlcjt_crs(:)
428	nldjt(:) = nldjt_crs(:)
429	nlejt(:) = nlejt_crs(:)
430	njmppt(:) = njmppt_crs(:)
431
432	nfsloop = nfsloop_crs
433	nfeloop = nfeloop_crs
434
435	nfiimpp(:,:) = nfiimpp_crs(:,:)
436
437	!
438	END SUBROUTINE dom_grid_crs
439
440
441	!!======================================================================
442
443	END MODULE crs
444

Note: See TracBrowser for help on using the repository browser.

Download in other formats: