Context Navigation

bdydta.F90 @ 8813

Last change on this file since 8813 was 8813, checked in by gm, 6 years ago
#1911 (ENHANCE-09): PART I.3 - phasing with updated branch dev_r8183_ICEMODEL revision 8787
Property svn:keywords set to `Id`
File size: 37.4 KB

Line
1	MODULE bdydta
2	!!======================================================================
3	!! * MODULE bdydta *
4	!! Open boundary data : read the data for the unstructured open boundaries.
5	!!======================================================================
6	!! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code
7	!! - ! 2007-01 (D. Storkey) Update to use IOM module
8	!! - ! 2007-07 (D. Storkey) add bdy_dta_fla
9	!! 3.0 ! 2008-04 (NEMO team) add in the reference version
10	!! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations
11	!! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions
12	!! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge
13	!! 3.6 ! 2012-01 (C. Rousset) add ice boundary conditions for lim3
14	!!----------------------------------------------------------------------
15
16	!!----------------------------------------------------------------------
17	!! bdy_dta : read external data along open boundaries from file
18	!! bdy_dta_init : initialise arrays etc for reading of external data
19	!!----------------------------------------------------------------------
20	USE oce ! ocean dynamics and tracers
21	USE dom_oce ! ocean space and time domain
22	USE phycst ! physical constants
23	USE sbcapr ! atmospheric pressure forcing
24	USE sbctide ! Tidal forcing or not
25	USE bdy_oce ! ocean open boundary conditions
26	USE bdytides ! tidal forcing at boundaries
27	#if defined key_lim3
28	USE ice ! sea-ice variables
29	USE icevar ! redistribute ice input into categories
30	#endif
31	!
32	USE fldread ! read input fields
33	USE iom ! IOM library
34	USE in_out_manager ! I/O logical units
35	USE timing ! Timing
36
37	IMPLICIT NONE
38	PRIVATE
39
40	PUBLIC bdy_dta ! routine called by step.F90 and dynspg_ts.F90
41	PUBLIC bdy_dta_init ! routine called by nemogcm.F90
42
43	INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_bdy_fld ! Number of fields to update for each boundary set.
44	INTEGER :: nb_bdy_fld_sum ! Total number of fields to update for all boundary sets.
45	LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions
46	! =F => baroclinic velocities in 3D boundary conditions
47	!$AGRIF_DO_NOT_TREAT
48	TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: bf ! structure of input fields (file informations, fields read)
49	!$AGRIF_END_DO_NOT_TREAT
50	TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap
51
52	#if defined key_lim3
53	INTEGER :: nice_cat ! number of categories in the input file
54	INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure
55	#endif
56
57	!!----------------------------------------------------------------------
58	!! NEMO/OPA 4.0 , NEMO Consortium (2017)
59	!! $Id$
60	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
61	!!----------------------------------------------------------------------
62	CONTAINS
63
64	SUBROUTINE bdy_dta( kt, jit, time_offset )
65	!!----------------------------------------------------------------------
66	!! * SUBROUTINE bdy_dta *
67	!!
68	!! ** Purpose : Update external data for open boundary conditions
69	!!
70	!! ** Method : Use fldread.F90
71	!!
72	!!----------------------------------------------------------------------
73	INTEGER, INTENT(in) :: kt ! ocean time-step index
74	INTEGER, INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)
75	INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit
76	! ! is present then units = subcycle timesteps.
77	! ! time_offset = 0 => get data at "now" time level
78	! ! time_offset = -1 => get data at "before" time level
79	! ! time_offset = +1 => get data at "after" time level
80	! ! etc.
81	!
82	INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices
83	INTEGER :: ii, ij, ik, igrd ! local integers
84	INTEGER, DIMENSION(jpbgrd) :: ilen1
85	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
86	TYPE(OBC_DATA), POINTER :: dta ! short cut
87	!!---------------------------------------------------------------------------
88	!
89	IF( nn_timing == 1 ) CALL timing_start('bdy_dta')
90	!
91	! Initialise data arrays once for all from initial conditions where required
92	!---------------------------------------------------------------------------
93	IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN
94
95	! Calculate depth-mean currents
96	!-----------------------------
97
98	DO jbdy = 1, nb_bdy
99	!
100	nblen => idx_bdy(jbdy)%nblen
101	nblenrim => idx_bdy(jbdy)%nblenrim
102	dta => dta_bdy(jbdy)
103	!
104	IF( nn_dyn2d_dta(jbdy) == 0 ) THEN
105	ilen1(:) = nblen(:)
106	IF( dta%ll_ssh ) THEN
107	igrd = 1
108	DO ib = 1, ilen1(igrd)
109	ii = idx_bdy(jbdy)%nbi(ib,igrd)
110	ij = idx_bdy(jbdy)%nbj(ib,igrd)
111	dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)
112	END DO
113	ENDIF
114	IF( dta%ll_u2d ) THEN
115	igrd = 2
116	DO ib = 1, ilen1(igrd)
117	ii = idx_bdy(jbdy)%nbi(ib,igrd)
118	ij = idx_bdy(jbdy)%nbj(ib,igrd)
119	dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)
120	END DO
121	ENDIF
122	IF( dta%ll_v2d ) THEN
123	igrd = 3
124	DO ib = 1, ilen1(igrd)
125	ii = idx_bdy(jbdy)%nbi(ib,igrd)
126	ij = idx_bdy(jbdy)%nbj(ib,igrd)
127	dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)
128	END DO
129	ENDIF
130	ENDIF
131	!
132	IF( nn_dyn3d_dta(jbdy) == 0 ) THEN
133	ilen1(:) = nblen(:)
134	IF( dta%ll_u3d ) THEN
135	igrd = 2
136	DO ib = 1, ilen1(igrd)
137	DO ik = 1, jpkm1
138	ii = idx_bdy(jbdy)%nbi(ib,igrd)
139	ij = idx_bdy(jbdy)%nbj(ib,igrd)
140	dta_bdy(jbdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)
141	END DO
142	END DO
143	ENDIF
144	IF( dta%ll_v3d ) THEN
145	igrd = 3
146	DO ib = 1, ilen1(igrd)
147	DO ik = 1, jpkm1
148	ii = idx_bdy(jbdy)%nbi(ib,igrd)
149	ij = idx_bdy(jbdy)%nbj(ib,igrd)
150	dta_bdy(jbdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)
151	END DO
152	END DO
153	ENDIF
154	ENDIF
155
156	IF( nn_tra_dta(jbdy) == 0 ) THEN
157	ilen1(:) = nblen(:)
158	IF( dta%ll_tem ) THEN
159	igrd = 1
160	DO ib = 1, ilen1(igrd)
161	DO ik = 1, jpkm1
162	ii = idx_bdy(jbdy)%nbi(ib,igrd)
163	ij = idx_bdy(jbdy)%nbj(ib,igrd)
164	dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)
165	END DO
166	END DO
167	ENDIF
168	IF( dta%ll_sal ) THEN
169	igrd = 1
170	DO ib = 1, ilen1(igrd)
171	DO ik = 1, jpkm1
172	ii = idx_bdy(jbdy)%nbi(ib,igrd)
173	ij = idx_bdy(jbdy)%nbj(ib,igrd)
174	dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)
175	END DO
176	END DO
177	ENDIF
178	ENDIF
179
180	#if defined key_lim3
181	IF( nn_ice_lim_dta(jbdy) == 0 ) THEN ! set ice to initial values
182	ilen1(:) = nblen(:)
183	IF( dta%ll_a_i ) THEN
184	igrd = 1
185	DO jl = 1, jpl
186	DO ib = 1, ilen1(igrd)
187	ii = idx_bdy(jbdy)%nbi(ib,igrd)
188	ij = idx_bdy(jbdy)%nbj(ib,igrd)
189	dta_bdy(jbdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1)
190	END DO
191	END DO
192	ENDIF
193	IF( dta%ll_h_i ) THEN
194	igrd = 1
195	DO jl = 1, jpl
196	DO ib = 1, ilen1(igrd)
197	ii = idx_bdy(jbdy)%nbi(ib,igrd)
198	ij = idx_bdy(jbdy)%nbj(ib,igrd)
199	dta_bdy(jbdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1)
200	END DO
201	END DO
202	ENDIF
203	IF( dta%ll_h_s ) THEN
204	igrd = 1
205	DO jl = 1, jpl
206	DO ib = 1, ilen1(igrd)
207	ii = idx_bdy(jbdy)%nbi(ib,igrd)
208	ij = idx_bdy(jbdy)%nbj(ib,igrd)
209	dta_bdy(jbdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1)
210	END DO
211	END DO
212	ENDIF
213	ENDIF
214	#endif
215	END DO ! jbdy
216	!
217	ENDIF ! kt == nit000
218
219	! update external data from files
220	!--------------------------------
221
222	jstart = 1
223	DO jbdy = 1, nb_bdy
224	dta => dta_bdy(jbdy)
225	IF( nn_dta(jbdy) == 1 ) THEN ! skip this bit if no external data required
226
227	IF( PRESENT(jit) ) THEN
228	! Update barotropic boundary conditions only
229	! jit is optional argument for fld_read and bdytide_update
230	IF( cn_dyn2d(jbdy) /= 'none' ) THEN
231	IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
232	IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
233	IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
234	IF( dta%ll_u3d ) dta%v2d(:) = 0._wp
235	ENDIF
236	IF (cn_tra(jbdy) /= 'runoff') THEN
237	IF( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) THEN
238
239	jend = jstart + dta%nread(2) - 1
240	IF( ln_full_vel_array(jbdy) ) THEN
241	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), &
242	& kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(jbdy) )
243	ELSE
244	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), &
245	& kit=jit, kt_offset=time_offset )
246	ENDIF
247
248	! If full velocities in boundary data then extract barotropic velocities from 3D fields
249	IF( ln_full_vel_array(jbdy) .AND. &
250	& ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. &
251	& nn_dyn3d_dta(jbdy) == 1 ) )THEN
252
253	igrd = 2 ! zonal velocity
254	dta%u2d(:) = 0._wp
255	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
256	ii = idx_bdy(jbdy)%nbi(ib,igrd)
257	ij = idx_bdy(jbdy)%nbj(ib,igrd)
258	DO ik = 1, jpkm1
259	dta%u2d(ib) = dta%u2d(ib) &
260	& + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
261	END DO
262	dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij)
263	END DO
264	igrd = 3 ! meridional velocity
265	dta%v2d(:) = 0._wp
266	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
267	ii = idx_bdy(jbdy)%nbi(ib,igrd)
268	ij = idx_bdy(jbdy)%nbj(ib,igrd)
269	DO ik = 1, jpkm1
270	dta%v2d(ib) = dta%v2d(ib) &
271	& + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
272	END DO
273	dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij)
274	END DO
275	ENDIF
276	ENDIF
277	IF( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN ! update tidal harmonic forcing
278	CALL bdytide_update( kt=kt, idx=idx_bdy(jbdy), dta=dta, td=tides(jbdy), &
279	& jit=jit, time_offset=time_offset )
280	ENDIF
281	ENDIF
282	ENDIF
283	ELSE
284	IF (cn_tra(jbdy) == 'runoff') then ! runoff condition
285	jend = nb_bdy_fld(jbdy)
286	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
287	& map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
288	!
289	igrd = 2 ! zonal velocity
290	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
291	ii = idx_bdy(jbdy)%nbi(ib,igrd)
292	ij = idx_bdy(jbdy)%nbj(ib,igrd)
293	dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
294	END DO
295	!
296	igrd = 3 ! meridional velocity
297	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
298	ii = idx_bdy(jbdy)%nbi(ib,igrd)
299	ij = idx_bdy(jbdy)%nbj(ib,igrd)
300	dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
301	END DO
302	ELSE
303	IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
304	IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
305	IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
306	IF( dta%ll_v2d ) dta%v2d(:) = 0._wp
307	ENDIF
308	IF( dta%nread(1) .gt. 0 ) THEN ! update external data
309	jend = jstart + dta%nread(1) - 1
310	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
311	& map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(jbdy) )
312	ENDIF
313	! If full velocities in boundary data then split into barotropic and baroclinic data
314	IF( ln_full_vel_array(jbdy) .and. &
315	& ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. &
316	& nn_dyn3d_dta(jbdy) == 1 ) ) THEN
317	igrd = 2 ! zonal velocity
318	dta%u2d(:) = 0._wp
319	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
320	ii = idx_bdy(jbdy)%nbi(ib,igrd)
321	ij = idx_bdy(jbdy)%nbj(ib,igrd)
322	DO ik = 1, jpkm1
323	dta%u2d(ib) = dta%u2d(ib) &
324	& + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
325	END DO
326	dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij)
327	DO ik = 1, jpkm1
328	dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib)
329	END DO
330	END DO
331	igrd = 3 ! meridional velocity
332	dta%v2d(:) = 0._wp
333	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
334	ii = idx_bdy(jbdy)%nbi(ib,igrd)
335	ij = idx_bdy(jbdy)%nbj(ib,igrd)
336	DO ik = 1, jpkm1
337	dta%v2d(ib) = dta%v2d(ib) &
338	& + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
339	END DO
340	dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij)
341	DO ik = 1, jpkm1
342	dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib)
343	END DO
344	END DO
345	ENDIF
346
347	ENDIF
348	#if defined key_lim3
349	IF( cn_ice_lim(jbdy) /= 'none' .AND. nn_ice_lim_dta(jbdy) == 1 ) THEN
350	IF( nice_cat == 1 ) THEN ! case input cat = 1
351	CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
352	& dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )
353	ELSEIF( nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl
354	CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), &
355	& dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )
356	ENDIF
357	ENDIF
358	#endif
359	ENDIF
360	jstart = jstart + dta%nread(1)
361	ENDIF ! nn_dta(jbdy) = 1
362	END DO ! jbdy
363
364	IF ( ln_tide ) THEN
365	IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data
366	DO jbdy = 1, nb_bdy ! Tidal component added in ts loop
367	IF ( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN
368	nblen => idx_bdy(jbdy)%nblen
369	nblenrim => idx_bdy(jbdy)%nblenrim
370	IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF
371	IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
372	IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
373	IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
374	ENDIF
375	END DO
376	ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
377	!
378	CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
379	ENDIF
380	ENDIF
381
382	IF ( ln_apr_obc ) THEN
383	DO jbdy = 1, nb_bdy
384	IF (cn_tra(jbdy) /= 'runoff')THEN
385	igrd = 1 ! meridional velocity
386	DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)
387	ii = idx_bdy(jbdy)%nbi(ib,igrd)
388	ij = idx_bdy(jbdy)%nbj(ib,igrd)
389	dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij)
390	END DO
391	ENDIF
392	END DO
393	ENDIF
394	!
395	IF( nn_timing == 1 ) CALL timing_stop('bdy_dta')
396	!
397	END SUBROUTINE bdy_dta
398
399
400	SUBROUTINE bdy_dta_init
401	!!----------------------------------------------------------------------
402	!! * SUBROUTINE bdy_dta_init *
403	!!
404	!! ** Purpose : Initialise arrays for reading of external data
405	!! for open boundary conditions
406	!!
407	!! ** Method :
408	!!
409	!!----------------------------------------------------------------------
410	INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers
411	!
412	CHARACTER(len=100) :: cn_dir ! Root directory for location of data files
413	CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files
414	CHARACTER(len = 256):: clname ! temporary file name
415	LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data
416	! ! =F => baroclinic velocities in 3D boundary data
417	INTEGER :: ilen_global ! Max length required for global bdy dta arrays
418	INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays
419	INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld
420	INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V)
421	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
422	TYPE(OBC_DATA), POINTER :: dta ! short cut
423	#if defined key_lim3
424	INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)
425	INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions
426	INTEGER :: inum,id1 ! local integer
427	#endif
428	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures
429	TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d !
430	TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read
431	#if defined key_lim3
432	TYPE(FLD_N) :: bn_a_i, bn_h_i, bn_h_s
433	#endif
434	NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d
435	#if defined key_lim3
436	NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s
437	#endif
438	NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy
439	!!---------------------------------------------------------------------------
440	!
441	IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')
442	!
443	IF(lwp) WRITE(numout,*)
444	IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
445	IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
446	IF(lwp) WRITE(numout,*) ''
447
448	! Set nn_dta
449	DO jbdy = 1, nb_bdy
450	nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) &
451	& , nn_dyn3d_dta (jbdy) &
452	& , nn_tra_dta (jbdy) &
453	#if defined key_lim3
454	& , nn_ice_lim_dta(jbdy) &
455	#endif
456	)
457	IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1
458	END DO
459
460	! Work out upper bound of how many fields there are to read in and allocate arrays
461	! ---------------------------------------------------------------------------
462	ALLOCATE( nb_bdy_fld(nb_bdy) )
463	nb_bdy_fld(:) = 0
464	DO jbdy = 1, nb_bdy
465	IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN
466	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3
467	ENDIF
468	IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN
469	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2
470	ENDIF
471	IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN
472	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2
473	ENDIF
474	#if defined key_lim3
475	IF( cn_ice_lim(jbdy) /= 'none' .AND. nn_ice_lim_dta(jbdy) == 1 ) THEN
476	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3
477	ENDIF
478	#endif
479	IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy)
480	END DO
481
482	nb_bdy_fld_sum = SUM( nb_bdy_fld )
483
484	ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
485	IF( ierror > 0 ) THEN
486	CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN
487	ENDIF
488	ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
489	IF( ierror > 0 ) THEN
490	CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN
491	ENDIF
492	ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
493	IF( ierror > 0 ) THEN
494	CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN
495	ENDIF
496	ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )
497	ALLOCATE( ibdy(nb_bdy_fld_sum) )
498	ALLOCATE( igrid(nb_bdy_fld_sum) )
499
500	! Read namelists
501	! --------------
502	REWIND(numnam_ref)
503	REWIND(numnam_cfg)
504	jfld = 0
505	DO jbdy = 1, nb_bdy
506	IF( nn_dta(jbdy) == 1 ) THEN
507	READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
508	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
509
510	READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
511	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
512	IF(lwm) WRITE( numond, nambdy_dta )
513
514	cn_dir_array(jbdy) = cn_dir
515	ln_full_vel_array(jbdy) = ln_full_vel
516
517	nblen => idx_bdy(jbdy)%nblen
518	nblenrim => idx_bdy(jbdy)%nblenrim
519	dta => dta_bdy(jbdy)
520	dta%nread(2) = 0
521
522	! Only read in necessary fields for this set.
523	! Important that barotropic variables come first.
524	IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN
525
526	IF( dta%ll_ssh ) THEN
527	if(lwp) write(numout,*) '++++++ reading in ssh field'
528	jfld = jfld + 1
529	blf_i(jfld) = bn_ssh
530	ibdy(jfld) = jbdy
531	igrid(jfld) = 1
532	ilen1(jfld) = nblen(igrid(jfld))
533	ilen3(jfld) = 1
534	dta%nread(2) = dta%nread(2) + 1
535	ENDIF
536
537	IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN
538	if(lwp) write(numout,*) '++++++ reading in u2d field'
539	jfld = jfld + 1
540	blf_i(jfld) = bn_u2d
541	ibdy(jfld) = jbdy
542	igrid(jfld) = 2
543	ilen1(jfld) = nblen(igrid(jfld))
544	ilen3(jfld) = 1
545	dta%nread(2) = dta%nread(2) + 1
546	ENDIF
547
548	IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN
549	if(lwp) write(numout,*) '++++++ reading in v2d field'
550	jfld = jfld + 1
551	blf_i(jfld) = bn_v2d
552	ibdy(jfld) = jbdy
553	igrid(jfld) = 3
554	ilen1(jfld) = nblen(igrid(jfld))
555	ilen3(jfld) = 1
556	dta%nread(2) = dta%nread(2) + 1
557	ENDIF
558
559	ENDIF
560
561	! read 3D velocities if baroclinic velocities require OR if
562	! barotropic velocities required and ln_full_vel set to .true.
563	IF( nn_dyn3d_dta(jbdy) == 1 .OR. &
564	& ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN
565
566	IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN
567	if(lwp) write(numout,*) '++++++ reading in u3d field'
568	jfld = jfld + 1
569	blf_i(jfld) = bn_u3d
570	ibdy(jfld) = jbdy
571	igrid(jfld) = 2
572	ilen1(jfld) = nblen(igrid(jfld))
573	ilen3(jfld) = jpk
574	IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1
575	ENDIF
576
577	IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN
578	if(lwp) write(numout,*) '++++++ reading in v3d field'
579	jfld = jfld + 1
580	blf_i(jfld) = bn_v3d
581	ibdy(jfld) = jbdy
582	igrid(jfld) = 3
583	ilen1(jfld) = nblen(igrid(jfld))
584	ilen3(jfld) = jpk
585	IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1
586	ENDIF
587
588	ENDIF
589
590	! temperature and salinity
591	IF( nn_tra_dta(jbdy) == 1 ) THEN
592
593	IF( dta%ll_tem ) THEN
594	if(lwp) write(numout,*) '++++++ reading in tem field'
595	jfld = jfld + 1
596	blf_i(jfld) = bn_tem
597	ibdy(jfld) = jbdy
598	igrid(jfld) = 1
599	ilen1(jfld) = nblen(igrid(jfld))
600	ilen3(jfld) = jpk
601	ENDIF
602
603	IF( dta%ll_sal ) THEN
604	if(lwp) write(numout,*) '++++++ reading in sal field'
605	jfld = jfld + 1
606	blf_i(jfld) = bn_sal
607	ibdy(jfld) = jbdy
608	igrid(jfld) = 1
609	ilen1(jfld) = nblen(igrid(jfld))
610	ilen3(jfld) = jpk
611	ENDIF
612
613	ENDIF
614
615	#if defined key_lim3
616	! sea ice
617	IF( nn_ice_lim_dta(jbdy) == 1 ) THEN
618	! Test for types of ice input (1cat or Xcat)
619	! Build file name to find dimensions
620	clname=TRIM( cn_dir )//TRIM(bn_a_i%clname)
621	IF( .NOT. bn_a_i%ln_clim ) THEN
622	WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear ! add year
623	IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month
624	ELSE
625	IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth ! add month
626	ENDIF
627	IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) &
628	& WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day
629	!
630	CALL iom_open ( clname, inum )
631	id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. )
632	CALL iom_close ( inum )
633
634	IF ( kndims == 4 ) THEN
635	nice_cat = kdimsz(4) ! Xcat input
636	ELSE
637	nice_cat = 1 ! 1cat input
638	ENDIF
639	! End test
640
641	IF( dta%ll_a_i ) THEN
642	jfld = jfld + 1
643	blf_i(jfld) = bn_a_i
644	ibdy(jfld) = jbdy
645	igrid(jfld) = 1
646	ilen1(jfld) = nblen(igrid(jfld))
647	ilen3(jfld) = nice_cat
648	ENDIF
649
650	IF( dta%ll_h_i ) THEN
651	jfld = jfld + 1
652	blf_i(jfld) = bn_h_i
653	ibdy(jfld) = jbdy
654	igrid(jfld) = 1
655	ilen1(jfld) = nblen(igrid(jfld))
656	ilen3(jfld) = nice_cat
657	ENDIF
658
659	IF( dta%ll_h_s ) THEN
660	jfld = jfld + 1
661	blf_i(jfld) = bn_h_s
662	ibdy(jfld) = jbdy
663	igrid(jfld) = 1
664	ilen1(jfld) = nblen(igrid(jfld))
665	ilen3(jfld) = nice_cat
666	ENDIF
667
668	ENDIF
669	#endif
670	! Recalculate field counts
671	!-------------------------
672	IF( jbdy == 1 ) THEN
673	nb_bdy_fld_sum = 0
674	nb_bdy_fld(jbdy) = jfld
675	nb_bdy_fld_sum = jfld
676	ELSE
677	nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum
678	nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy)
679	ENDIF
680
681	dta%nread(1) = nb_bdy_fld(jbdy)
682
683	ENDIF ! nn_dta == 1
684	ENDDO ! jbdy
685
686	DO jfld = 1, nb_bdy_fld_sum
687	ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
688	IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
689	nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
690	nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld))
691	ENDDO
692
693	! fill bf with blf_i and control print
694	!-------------------------------------
695	jstart = 1
696	DO jbdy = 1, nb_bdy
697	jend = jstart - 1 + nb_bdy_fld(jbdy)
698	CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', &
699	& 'open boundary conditions', 'nambdy_dta' )
700	jstart = jend + 1
701	ENDDO
702
703	! Initialise local boundary data arrays
704	! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
705	! nn_xxx_dta=1 : point to "fnow" arrays
706	!-------------------------------------
707
708	jfld = 0
709	DO jbdy=1, nb_bdy
710
711	nblen => idx_bdy(jbdy)%nblen
712	dta => dta_bdy(jbdy)
713
714	if(lwp) then
715	write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh
716	write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d
717	write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d
718	write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d
719	write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d
720	write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem
721	write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal
722	endif
723
724	IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN
725	if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space'
726	IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) )
727	IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) )
728	IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
729	ENDIF
730	IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN
731	IF( dta%ll_ssh ) THEN
732	if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
733	jfld = jfld + 1
734	dta%ssh => bf(jfld)%fnow(:,1,1)
735	ENDIF
736	IF ( dta%ll_u2d ) THEN
737	IF ( ln_full_vel_array(jbdy) ) THEN
738	if(lwp) write(numout,*) '++++++ dta%u2d allocated space'
739	ALLOCATE( dta%u2d(nblen(2)) )
740	ELSE
741	if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow'
742	jfld = jfld + 1
743	dta%u2d => bf(jfld)%fnow(:,1,1)
744	ENDIF
745	ENDIF
746	IF ( dta%ll_v2d ) THEN
747	IF ( ln_full_vel_array(jbdy) ) THEN
748	if(lwp) write(numout,*) '++++++ dta%v2d allocated space'
749	ALLOCATE( dta%v2d(nblen(3)) )
750	ELSE
751	if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow'
752	jfld = jfld + 1
753	dta%v2d => bf(jfld)%fnow(:,1,1)
754	ENDIF
755	ENDIF
756	ENDIF
757
758	IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN
759	if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space'
760	IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) )
761	IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) )
762	ENDIF
763	IF ( nn_dyn3d_dta(jbdy) == 1 .or. &
764	& ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN
765	IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN
766	if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow'
767	jfld = jfld + 1
768	dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:)
769	ENDIF
770	IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN
771	if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow'
772	jfld = jfld + 1
773	dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:)
774	ENDIF
775	ENDIF
776
777	IF( nn_tra_dta(jbdy) == 0 ) THEN
778	if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space'
779	IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) )
780	IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) )
781	ELSE
782	IF( dta%ll_tem ) THEN
783	if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow'
784	jfld = jfld + 1
785	dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:)
786	ENDIF
787	IF( dta%ll_sal ) THEN
788	if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow'
789	jfld = jfld + 1
790	dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:)
791	ENDIF
792	ENDIF
793
794	#if defined key_lim3
795	IF (cn_ice_lim(jbdy) /= 'none') THEN
796	IF( nn_ice_lim_dta(jbdy) == 0 ) THEN
797	ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) )
798	ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) )
799	ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) )
800	ELSE
801	IF ( nice_cat == jpl ) THEN ! case input cat = jpl
802	jfld = jfld + 1
803	dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:)
804	jfld = jfld + 1
805	dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:)
806	jfld = jfld + 1
807	dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:)
808	ELSE ! case input cat = 1 OR (/=1 and /=jpl)
809	jfld_ai = jfld + 1
810	jfld_hti = jfld + 2
811	jfld_hts = jfld + 3
812	jfld = jfld + 3
813	ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) )
814	ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) )
815	ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) )
816	dta_bdy(jbdy)%a_i(:,:) = 0._wp
817	dta_bdy(jbdy)%h_i(:,:) = 0._wp
818	dta_bdy(jbdy)%h_s(:,:) = 0._wp
819	ENDIF
820
821	ENDIF
822	ENDIF
823	#endif
824	!
825	END DO ! jbdy
826	!
827	IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
828	!
829	END SUBROUTINE bdy_dta_init
830
831	!!==============================================================================
832	END MODULE bdydta

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

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

Context Navigation

source: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 @ 8813

Download in other formats: