Context Navigation

crs.F90 @ 10239

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/dev_r10171_test_crs_AMM7/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90 @ 10239

Download in other formats: