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.

crsfld.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/crsfld.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: 24.5 KB

Line
1	MODULE crsfld
2	!!======================================================================
3	!! * MODULE crsdfld *
4	!! Ocean coarsening : coarse ocean fields
5	!!=====================================================================
6	!! 2012-07 (J. Simeon, C. Calone, G. Madec, C. Ethe)
7	!!----------------------------------------------------------------------
8
9	!!----------------------------------------------------------------------
10	!! crs_fld : create the standard output files for coarse grid and prep
11	!! other variables needed to be passed to TOP
12	!!----------------------------------------------------------------------
13	USE oce ! ocean dynamics and tracers
14	USE dom_oce ! ocean space and time domain
15	USE ldftra_oce ! ocean active tracers: lateral physics
16	USE sbc_oce ! Surface boundary condition: ocean fields
17	USE sbcrnf
18	USE zdf_oce ! vertical physics: ocean fields
19	USE zdfddm ! vertical physics: double diffusion
20	USe zdfmxl
21	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
22	USE in_out_manager ! I/O manager
23	USE timing ! preformance summary
24	USE wrk_nemo ! working array
25	USE crs
26	USE crsdom
27	USE domvvl
28	USE domvvl_crs
29	USE crslbclnk
30	USE iom
31	USE zdfmxl_crs
32	USE eosbn2
33	USE zdfevd_crs
34	USE zdftke
35	USE zdftke_crs
36	USE trc, ONLY: qsr_mean
37	USE ieee_arithmetic
38
39	IMPLICIT NONE
40	PRIVATE
41
42	PUBLIC crs_fld ! routines called by step.F90
43
44
45	!! * Substitutions
46	# include "zdfddm_substitute.h90"
47	# include "domzgr_substitute.h90"
48	# include "vectopt_loop_substitute.h90"
49	!!----------------------------------------------------------------------
50	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
51	!! $Id $
52	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
53	!!----------------------------------------------------------------------
54	CONTAINS
55
56	SUBROUTINE crs_fld( kt )
57	!!---------------------------------------------------------------------
58	!! * ROUTINE crs_fld *
59	!!
60	!! ** Purpose : Basic output of coarsened dynamics and tracer fields
61	!! NETCDF format is used by default
62	!! 1. Accumulate in time the dimensionally-weighted fields
63	!! 2. At time of output, rescale [1] by dimension and time
64	!! to yield the spatial and temporal average.
65	!! See. diawri_dimg.h90, sbcmod.F90
66	!!
67	!! ** Method :
68	!!----------------------------------------------------------------------
69	!!
70
71	INTEGER, INTENT( in ) :: kt ! ocean time-step index
72	!!
73	INTEGER :: ji, jj, jk ! dummy loop indices
74	!!
75	REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
76	REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp
77	REAL(wp), POINTER, DIMENSION(:,:) :: z2d,z2d_crs
78	REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs
79	REAL(wp):: z2dcrsu, z2dcrsv
80	REAL(wp):: z1_2dt
81	REAL(wp):: zmin,zmax
82	INTEGER :: i,j,ijis,ijie,ijjs,ijje
83	INTEGER :: iji,ijj
84	INTEGER :: jl,jm,jn
85	!!
86	!!----------------------------------------------------------------------
87
88	IF( nn_timing == 1 ) CALL timing_start('crs_fld')
89
90	! Initialize arrays
91	CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
92	CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
93	CALL wrk_alloc( jpi, jpj, jpk, zt, zs , ztmp )
94	CALL wrk_alloc( jpi, jpj, z2d )
95	!
96	CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
97	CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs )
98
99	CALL iom_swap( "nemo_crs" ) ! swap on the coarse grid
100
101	!---------------------------------------------------------------------------------------------------
102	!scale factors: swap
103	!---------------------------------------------------------------------------------------------------
104	#if defined key_vvl
105	!e3t_b_crs(:,:,:) = e3t_n_crs(:,:,:)
106	!e3u_b_crs(:,:,:) = e3u_n_crs(:,:,:)
107	!e3v_b_crs(:,:,:) = e3v_n_crs(:,:,:)
108	!e3w_b_crs(:,:,:) = e3w_n_crs(:,:,:)
109	!e3t_n_crs(:,:,:) = e3t_a_crs(:,:,:)
110	!e3u_n_crs(:,:,:) = e3u_a_crs(:,:,:)
111	!e3v_n_crs(:,:,:) = e3v_a_crs(:,:,:)
112	!e3w_n_crs(:,:,:) = e3w_a_crs(:,:,:)
113
114	!cbr: ds dynnxt, si (lk_dynspg_ts.AND.ln_bt_fw) on fait un swap simple ( e3X_b_crs=e3X_n_crs )
115	! sinon e3X_b_crs passe par le filtre d'asselin !!!!!!
116	! ds dommvl, swap simple pr e3X_n_crs=e3X_a_crs
117
118
119	IF( kt /= nit000 )THEN
120	zfse3t(:,:,:) = e3t_b(:,:,:)
121	zfse3u(:,:,:) = e3u_b(:,:,:)
122	zfse3v(:,:,:) = e3v_b(:,:,:)
123	zfse3w(:,:,:) = e3w_b(:,:,:)
124	CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_b_crs, p_e3_max_crs=zs_crs)
125	CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_b_crs, p_e3_max_crs=zs_crs)
126	CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs , cd_type='U', p_mask=umask, p_e3_crs=e3u_b_crs, p_e3_max_crs=zs_crs)
127	CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=e3v_b_crs, p_e3_max_crs=zs_crs)
128	DO jk = 1, jpk
129	DO ji = 1, jpi_crs
130	DO jj = 1, jpj_crs
131	IF( e3t_b_crs(ji,jj,jk) == 0._wp ) e3t_b_crs(ji,jj,jk) = e3t_1d(jk)
132	IF( e3w_b_crs(ji,jj,jk) == 0._wp ) e3w_b_crs(ji,jj,jk) = e3w_1d(jk)
133	IF( e3u_b_crs(ji,jj,jk) == 0._wp ) e3u_b_crs(ji,jj,jk) = e3t_1d(jk)
134	IF( e3v_b_crs(ji,jj,jk) == 0._wp ) e3v_b_crs(ji,jj,jk) = e3t_1d(jk)
135	ENDDO
136	ENDDO
137	ENDDO
138
139	e3t_n_crs(:,:,:) = e3t_a_crs(:,:,:)
140	e3u_n_crs(:,:,:) = e3u_a_crs(:,:,:)
141	e3v_n_crs(:,:,:) = e3v_a_crs(:,:,:)
142	e3w_n_crs(:,:,:) = e3w_a_crs(:,:,:)
143
144	ENDIF
145	#endif
146	!---------------------------------------------------------------------------------------------------
147	!variables domaine au temps before : swap
148	!---------------------------------------------------------------------------------------------------
149	#if defined key_vvl
150	zfse3t(:,:,:) = e3t_b(:,:,:)
151	zfse3u(:,:,:) = e3u_b(:,:,:)
152	zfse3v(:,:,:) = e3v_b(:,:,:)
153	zfse3w(:,:,:) = e3w_b(:,:,:)
154	#else
155	zfse3t(:,:,:) = e3t_0(:,:,:)
156	zfse3u(:,:,:) = e3u_0(:,:,:)
157	zfse3v(:,:,:) = e3v_0(:,:,:)
158	zfse3w(:,:,:) = e3w_0(:,:,:)
159	#endif
160
161	!zmin=MINVAL();zmax=MAXVAL();CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ",zmin,zmax
162	!zmin=MINVAL();zmax=MAXVAL();CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ",zmin,zmax
163
164	IF( kt /= nit000 )THEN
165	emp_b_crs(:,:) = emp_crs(:,:)
166	rnf_b_crs(:,:) = rnf_crs(:,:)
167	hdivb_crs(:,:,:) = hdivn_crs(:,:,:) !cbr hdivb_crs pas utile ?????????????????????????????????
168	ELSE
169	emp_b_crs(:,: ) = 0._wp
170	rnf_b_crs(:,: ) = 0._wp
171	hdivb_crs(:,:,: ) = 0._wp !cbr hdivb_crs pas utile ?????????????????????????????????
172	ENDIF
173
174	! Temperature
175	zt(:,:,:) = tsb(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp
176	CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
177	tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
178
179	! Salinity
180	zs(:,:,:) = tsb(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp
181	CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
182	tsb_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
183
184	! U-velocity !cb pas utile ?????????????????????????????????
185	CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
186
187	! V-velocity pas utile ?????????????????????????????????
188	CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
189
190	! n2
191	CALL crs_dom_ope( rn2b, 'VOL', 'W', tmask, rb2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
192
193	!ssh !cbr pas utile ??????????????????????????????????????
194	zfse3t(:,:,:) = 1._wp
195	CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 )
196
197	!---------------------------------------------------------------------------------------------------
198	!variables domaine au temps now :
199	!---------------------------------------------------------------------------------------------------
200	#if defined key_vvl
201	zfse3t(:,:,:) = e3t_n(:,:,:)
202	zfse3u(:,:,:) = e3u_n(:,:,:)
203	zfse3v(:,:,:) = e3v_n(:,:,:)
204	zfse3w(:,:,:) = e3w_n(:,:,:)
205	CALL iom_put("e3t",e3t_n_crs)
206	CALL iom_put("e3u",e3u_n_crs)
207	CALL iom_put("e3v",e3v_n_crs)
208	CALL iom_put("e3w",e3w_n_crs)
209	#else
210	zfse3t(:,:,:) = e3t_0(:,:,:)
211	zfse3u(:,:,:) = e3u_0(:,:,:)
212	zfse3v(:,:,:) = e3v_0(:,:,:)
213	zfse3w(:,:,:) = e3w_0(:,:,:)
214	#endif
215
216	#if defined key_vvl
217	CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
218	CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
219	CALL iom_put("e2e3u_crs",e2e3u_crs)
220	CALL iom_put("e2e3u_msk",e2e3u_msk)
221	CALL iom_put("e1e3v_crs",e1e3v_crs)
222	CALL iom_put("e1e3v_msk",e1e3v_msk)
223	!
224	CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3t_max_n_crs)
225	CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3w_max_n_crs)
226	CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs , cd_type='U', p_mask=umask, p_e3_crs=zs_crs, p_e3_max_crs=e3u_max_n_crs)
227	CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=zs_crs, p_e3_max_crs=e3v_max_n_crs)
228
229	DO jk = 1, jpk
230	DO ji = 1, jpi_crs
231	DO jj = 1, jpj_crs
232	IF( e3t_n_crs(ji,jj,jk) == 0._wp ) e3t_n_crs(ji,jj,jk) = e3t_1d(jk)
233	IF( e3w_n_crs(ji,jj,jk) == 0._wp ) e3w_n_crs(ji,jj,jk) = e3w_1d(jk)
234	IF( e3u_n_crs(ji,jj,jk) == 0._wp ) e3u_n_crs(ji,jj,jk) = e3t_1d(jk)
235	IF( e3v_n_crs(ji,jj,jk) == 0._wp ) e3v_n_crs(ji,jj,jk) = e3t_1d(jk)
236	IF( e3t_max_n_crs(ji,jj,jk) == 0._wp ) e3t_max_n_crs(ji,jj,jk) = e3t_1d(jk)
237	IF( e3w_max_n_crs(ji,jj,jk) == 0._wp ) e3w_max_n_crs(ji,jj,jk) = e3w_1d(jk)
238	IF( e3u_max_n_crs(ji,jj,jk) == 0._wp ) e3u_max_n_crs(ji,jj,jk) = e3t_1d(jk)
239	IF( e3v_max_n_crs(ji,jj,jk) == 0._wp ) e3v_max_n_crs(ji,jj,jk) = e3t_1d(jk)
240	ENDDO
241	ENDDO
242	ENDDO
243
244	CALL crs_dom_ope( gdepw_n, 'MAX', 'T', tmask, gdept_n_crs, p_e3=zfse3t, psgn=1.0 )
245	CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 )
246	DO jk = 1, jpk
247	DO ji = 1, jpi_crs
248	DO jj = 1, jpj_crs
249	IF( gdept_n_crs(ji,jj,jk) .LE. 0._wp ) gdept_n_crs(ji,jj,jk) = gdept_1d(jk)
250	IF( gdepw_n_crs(ji,jj,jk) .LE. 0._wp ) gdepw_n_crs(ji,jj,jk) = gdepw_1d(jk)
251	ENDDO
252	ENDDO
253	ENDDO
254	zmin=MINVAL(gdept_n_crs);zmax=MAXVAL(gdept_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld gdept_n_crs",zmin,zmax
255	zmin=MINVAL(gdepw_n_crs);zmax=MAXVAL(gdepw_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld gdepw_n_crs",zmin,zmax
256
257	CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t )
258	CALL iom_put("cvol_crs_t",ocean_volume_crs_t)
259	!
260	bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)*tmask_crs(:,:,:)
261	!
262	r1_bt_crs(:,:,:) = 0._wp
263	WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
264
265	CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w )
266
267	#endif
268
269	! Temperature
270	zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp
271	CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
272	tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
273
274	CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) ) ! temp
275	CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) ) ! sst
276
277	! Salinity
278	zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp
279	CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
280	tsn_crs(:,:,:,jp_sal) = zs_crs(:,:,:)
281
282	CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) ) ! sal
283	CALL iom_put( "sss" , tsn_crs(:,:,1,jp_sal) ) ! sss
284
285	! U-velocity
286	CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
287	un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) !cbr utile ??????????????????
288	CALL iom_put( "uoce" , un_crs ) ! i-current
289
290	! V-velocity
291	CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
292	vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) !cbr utile ??????????????????
293	CALL iom_put( "voce" , vn_crs ) ! i-current
294
295	!n2
296	CALL crs_dom_ope( rn2 , 'VOL', 'W', tmask, rn2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
297
298	! Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 )
299	hdivn_crs(:,:,:)=0._wp
300	DO jk = 1, jpkm1
301	DO jj = 2,jpj_crs
302	DO ji = 2,jpi_crs
303	z2dcrsu = ( un_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) &
304	& - ( un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) )
305	z2dcrsv = ( vn_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) &
306	& - ( vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) )
307
308	hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv )
309	ENDDO
310	ENDDO
311	ENDDO
312	CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
313	!
314	CALL iom_put( "hdiv", hdivn_crs )
315
316
317	! avt, avs
318	SELECT CASE ( nn_crs_kz )
319	CASE ( 0 )
320	CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
321	CASE ( 1 )
322	CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
323	CASE ( 2 )
324	CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
325	CASE ( 3 )
326	CALL crs_dom_ope( avt, 'LOGVOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 )
327	CASE ( 4 )
328	CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
329	CASE ( 5 )
330	#if defined key_zdftke
331	CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs , p_e12=e1e2t, p_e3=zfse3w , psgn=1.0 )
332	CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
333	CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 )
334	IF( kt==nit000 )CALL tke_avn_ini_crs
335	CALL tke_avn_crs
336	CALL zdf_evd_crs(kt)
337	#endif
338
339	END SELECT
340	!
341	CALL iom_put( "avt", avt_crs ) ! Kz
342
343	!2D fields
344	CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 )
345	CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 )
346	CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
347	CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0 )
348	CALL crs_dom_ope( h_rnf, 'MAX', 'T', tmask, h_rnf_crs , psgn=1.0 )
349	z2d=REAL(nk_rnf,wp)
350	CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
351	nk_rnf_crs=INT(z2d_crs)
352	CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
353
354	!???#if defined key_vvl
355	! CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 )
356	!#else
357	! CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 )
358	!#endif
359	CALL crs_dom_ope( emp ,'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
360	CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
361	CALL crs_dom_ope( sfx ,'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
362	CALL crs_dom_ope( fr_i ,'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
363
364	z2d=REAL(nmln,wp)
365	CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
366	nmln_crs=INT(z2d_crs)
367	nmln_crs=MAX(nlb10,nmln_crs)
368
369	CALL iom_put( "utau" , utau_crs ) ! i-tau output
370	CALL iom_put( "vtau" , vtau_crs ) ! j-tau output
371	CALL iom_put( "wspd" , wndm_crs ) ! wind speed output
372	CALL iom_put( "runoffs" , rnf_crs ) ! runoff output
373	CALL iom_put( "qsr" , qsr_crs ) ! qsr output
374	CALL iom_put( "empmr" , emp_crs ) ! water flux output
375	CALL iom_put( "saltflx" , sfx_crs ) ! salt flux output
376	CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output
377
378	zfse3t(:,:,:) = 1._wp
379	CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 )
380	CALL iom_put( "ssh" , sshn_crs ) ! ssh output
381
382	zmin=MINVAL(emp);zmax=MAXVAL(emp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp",zmin,zmax
383	zmin=MINVAL(emp_b);zmax=MAXVAL(emp_b);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp_b",zmin,zmax
384	zmin=MINVAL(emp_crs);zmax=MAXVAL(emp_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp_crs",zmin,zmax
385	zmin=MINVAL(emp_b_crs);zmax=MAXVAL(emp_b_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld emp_b_crs",zmin,zmax
386
387	#if defined key_vvl
388	!---------------------------------------------------------------------------------------------------
389	!variables au temps after
390	!---------------------------------------------------------------------------------------------------
391
392	!cbr ssha_crs utile ??????????????????
393	zfse3t(:,:,:) = 1._wp
394	zt(:,:,:) = tmask(:,:,:)
395	ssha(:,:) = ssha(:,:) * tmask(:,:,1) !cbr utile ??????????????????
396	CALL crs_dom_ope( ssha , 'VOL', 'T', zt, ssha_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 )
397	!CALL crs_lbc_lnk( ssha_crs, 'T', 1.0 ) !!!!!!!!!!!!!!!!!!! pas utile !!!!!!!!!!!!!!!!!!!!!!!!!
398
399
400	zfse3t(:,:,:) = e3t_a(:,:,:)
401	zfse3u(:,:,:) = e3u_a(:,:,:)
402	zfse3v(:,:,:) = e3v_a(:,:,:)
403	CALL dom_vvl_interpol( zfse3t(:,:,:), zfse3w(:,:,:), 'W' )
404
405	CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_a_crs, p_e3_max_crs=zs_crs)
406	CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_a_crs, p_e3_max_crs=zs_crs)
407	CALL crs_dom_e3( e1u, e2u, zfse3u, p_sfc_2d_crs=e2u_crs , cd_type='U', p_mask=umask, p_e3_crs=e3u_a_crs, p_e3_max_crs=zs_crs)
408	CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=e3v_a_crs, p_e3_max_crs=zs_crs)
409
410
411	!DO ji=1,jpi_crs
412	! DO jj=1,jpj_crs
413	! fse3t_a_crs(ji,jj,jk),fse3t_b_crs(ji,jj,jk)+fse3t_n_crs(ji,jj,jk)*(ssha_crs(ji,jj)-sshb_crs(ji,jj))/(ht_0_crs(ji,jj)+sshn_crs(ji,jj))
414	! ENDDO
415	!ENDDO
416	!CALL dom_vvl_interpol_crs( fse3t_a_crs(:,:,:), fse3u_a(:,:,:), 'U' )
417	!CALL dom_vvl_interpol_crs( fse3t_a_crs(:,:,:), fse3v_a(:,:,:), 'V' )
418	!CALL dom_vvl_interpol_crs( fse3t_a_crs(:,:,:), fse3w_a(:,:,:), 'W' )
419
420	!CALL crs_dom_sfc( umask, 'U', zt_crs, zs_crs, p_e2=e2u, p_e3=zfse3u ) ! zt_crs=e2e3u_crs,zs_crs=e2e3u_msk ça sert à quoi ???????????????????????????????????????????
421	!CALL crs_dom_sfc( vmask, 'V', zt_crs, zs_crs, p_e1=e2v, p_e3=zfse3v ) ! zt_crs=e1e3v_crs,zs_crs=e1e3v_msk ça sert à quoi ???????????????????????????????????????????
422
423	DO jk = 1, jpk
424	DO ji = 1, jpi_crs
425	DO jj = 1, jpj_crs
426	IF( e3t_a_crs(ji,jj,jk) == 0._wp ) e3t_a_crs(ji,jj,jk) = e3t_1d(jk)
427	IF( e3w_a_crs(ji,jj,jk) == 0._wp ) e3w_a_crs(ji,jj,jk) = e3w_1d(jk)
428	IF( e3u_a_crs(ji,jj,jk) == 0._wp ) e3u_a_crs(ji,jj,jk) = e3t_1d(jk)
429	IF( e3v_a_crs(ji,jj,jk) == 0._wp ) e3v_a_crs(ji,jj,jk) = e3t_1d(jk)
430	ENDDO
431	ENDDO
432	ENDDO
433
434	zmin=MINVAL(e3t_b);zmax=MAXVAL(e3t_b);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_b",zmin,zmax
435	zmin=MINVAL(e3t_n);zmax=MAXVAL(e3t_n);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_n",zmin,zmax
436	zmin=MINVAL(e3t_a);zmax=MAXVAL(e3t_a);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_a",zmin,zmax
437	zmin=MINVAL(e3t_b_crs);zmax=MAXVAL(e3t_b_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_b_crs",zmin,zmax
438	zmin=MINVAL(e3t_n_crs);zmax=MAXVAL(e3t_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_n_crs",zmin,zmax
439	zmin=MINVAL(e3t_a_crs);zmax=MAXVAL(e3t_a_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_a_crs",zmin,zmax
440	zmin=MINVAL(e3t_max_n_crs);zmax=MAXVAL(e3t_max_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_max_n_crs",zmin,zmax
441	zmin=MINVAL(e3w_max_n_crs);zmax=MAXVAL(e3w_max_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3w_max_n_crs",zmin,zmax
442	zmin=MINVAL(sshb);zmax=MAXVAL(sshb);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshb",zmin,zmax
443	zmin=MINVAL(sshn);zmax=MAXVAL(sshn);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshn",zmin,zmax
444	zmin=MINVAL(ssha);zmax=MAXVAL(ssha);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ssha",zmin,zmax
445	zmin=MINVAL(sshb_crs);zmax=MAXVAL(sshb_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshb_crs",zmin,zmax
446	zmin=MINVAL(sshn_crs);zmax=MAXVAL(sshn_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshn_crs",zmin,zmax
447	zmin=MINVAL(ssha_crs);zmax=MAXVAL(ssha_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld ssha_crs",zmin,zmax
448
449	!zt_crs=ocean_volume_crs_t ; zs_crs=facvol_t after time !!! ça sert à quoi ???????????????????????????????????????????
450	CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, zt_crs, zs_crs )
451
452	#endif
453
454	#if defined key_vvl
455	z1_2dt = 1._wp / ( 2. * rdt ) ! set time step size (Euler/Leapfrog)
456	IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt
457	wn_crs(:,:,jpk) = 0._wp
458	DO jk = jpkm1, 1, -1
459	wn_crs(:,:,jk) = wn_crs(:,:,jk+1)*e1e2w_msk(:,:,jk+1) - ( hdivn_crs(:,:,jk) &
460	& + z1_2dt * e1e2w_crs(:,:,jk) * ( e3t_a_crs(:,:,jk) - e3t_b_crs(:,:,jk) ) ) * tmask_crs(:,:,jk)
461	WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)
462
463
464	ENDDO
465	#else
466	IF( ln_crs_wn ) THEN
467	CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
468	ELSE
469	wn_crs(:,:,jpk) = 0._wp
470	DO jk = jpkm1, 1, -1
471	wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk)
472	WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk)
473	ENDDO
474	ENDIF
475
476	#endif
477	CALL crs_lbc_lnk( wn_crs, 'W', 1.0 ) !!!!!!!pas utile, nan ??????????????????????
478	wn_crs(:,:,:) = wn_crs(:,:,:) * tmask_crs(:,:,:) !!!!!!!pas utile, nan ??????????????????????
479
480	CALL iom_put( "woce", wn_crs ) ! vertical velocity
481
482	! free memory
483	CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
484	CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )
485	CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp )
486	CALL wrk_dealloc( jpi, jpj, z2d )
487	CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
488	CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs )
489	!
490	CALL iom_swap( "nemo" ) ! return back on high-resolution grid
491	!
492	IF( nn_timing == 1 ) CALL timing_stop('crs_fld')
493	!
494	END SUBROUTINE crs_fld
495
496	!!======================================================================
497	END MODULE crsfld

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

Download in other formats: