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.

bdydta.F90 in branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Context Navigation

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

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

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

Download in other formats: