Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

bdydta.F90

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

Download in other formats: