Context Navigation

bdydta.F90 @ 10986

Last change on this file since 10986 was 10986, checked in by andmirek, 5 years ago
GMED 462 add flush
File size: 39.8 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, &
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, &
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	IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1
360	CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
361	& dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )
362	ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl
363	CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), &
364	& dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )
365	ENDIF
366	ENDIF
367	#endif
368	ENDIF
369	jstart = jstart + dta%nread(1)
370	ENDIF ! nn_dta(jbdy) = 1
371	END DO ! jbdy
372
373	IF ( ln_apr_obc ) THEN
374	DO jbdy = 1, nb_bdy
375	IF (cn_tra(jbdy) /= 'runoff')THEN
376	igrd = 1 ! meridional velocity
377	DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)
378	ii = idx_bdy(jbdy)%nbi(ib,igrd)
379	ij = idx_bdy(jbdy)%nbj(ib,igrd)
380	dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij)
381	END DO
382	ENDIF
383	END DO
384	ENDIF
385
386	IF ( ln_tide ) THEN
387	IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data
388	DO jbdy = 1, nb_bdy ! Tidal component added in ts loop
389	IF ( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN
390	nblen => idx_bdy(jbdy)%nblen
391	nblenrim => idx_bdy(jbdy)%nblenrim
392	IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF
393	IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
394	IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
395	IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
396	ENDIF
397	END DO
398	ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
399	!
400	CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
401	ENDIF
402	ENDIF
403
404	!
405	IF( ln_timing ) CALL timing_stop('bdy_dta')
406	!
407	END SUBROUTINE bdy_dta
408
409
410	SUBROUTINE bdy_dta_init
411	!!----------------------------------------------------------------------
412	!! * SUBROUTINE bdy_dta_init *
413	!!
414	!! ** Purpose : Initialise arrays for reading of external data
415	!! for open boundary conditions
416	!!
417	!! ** Method :
418	!!
419	!!----------------------------------------------------------------------
420	INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers
421	!
422	CHARACTER(len=100) :: cn_dir ! Root directory for location of data files
423	CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files
424	CHARACTER(len = 256):: clname ! temporary file name
425	LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data
426	! ! =F => baroclinic velocities in 3D boundary data
427	INTEGER :: ilen_global ! Max length required for global bdy dta arrays
428	INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays
429	INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld
430	INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V)
431	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
432	TYPE(OBC_DATA), POINTER :: dta ! short cut
433	#if defined key_si3
434	INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)
435	INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions
436	INTEGER :: inum,id1 ! local integer
437	#endif
438	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures
439	TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d !
440	TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read
441	#if defined key_si3
442	TYPE(FLD_N) :: bn_a_i, bn_h_i, bn_h_s
443	#endif
444	NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d
445	#if defined key_si3
446	NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s
447	#endif
448	NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy
449	!!---------------------------------------------------------------------------
450	!
451	IF(lwp) THEN
452	WRITE(numout,*)
453	WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
454	WRITE(numout,*) '~~~~~~~~~~'
455	WRITE(numout,*) ''
456	IF(lflush) CALL FLUSH(numout)
457	ENDIF
458
459	! Set nn_dta
460	DO jbdy = 1, nb_bdy
461	nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) &
462	& , nn_dyn3d_dta (jbdy) &
463	& , nn_tra_dta (jbdy) &
464	#if defined key_si3
465	& , nn_ice_dta (jbdy) &
466	#endif
467	)
468	IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1
469	END DO
470
471	! Work out upper bound of how many fields there are to read in and allocate arrays
472	! ---------------------------------------------------------------------------
473	ALLOCATE( nb_bdy_fld(nb_bdy) )
474	nb_bdy_fld(:) = 0
475	DO jbdy = 1, nb_bdy
476	IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN
477	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3
478	ENDIF
479	IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN
480	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2
481	ENDIF
482	IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN
483	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2
484	ENDIF
485	#if defined key_si3
486	IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN
487	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3
488	ENDIF
489	#endif
490	IF(lwp) THEN
491	WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy)
492	IF(lflush) CALL FLUSH(numout)
493	ENDIF
494	END DO
495
496	nb_bdy_fld_sum = SUM( nb_bdy_fld )
497
498	ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
499	IF( ierror > 0 ) THEN
500	CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN
501	ENDIF
502	ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
503	IF( ierror > 0 ) THEN
504	CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN
505	ENDIF
506	ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
507	IF( ierror > 0 ) THEN
508	CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN
509	ENDIF
510	ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )
511	ALLOCATE( ibdy(nb_bdy_fld_sum) )
512	ALLOCATE( igrid(nb_bdy_fld_sum) )
513
514	! Read namelists
515	! --------------
516	REWIND(numnam_ref)
517	REWIND(numnam_cfg)
518	jfld = 0
519	DO jbdy = 1, nb_bdy
520	IF( nn_dta(jbdy) == 1 ) THEN
521	READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
522	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
523	READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
524	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
525	IF(lwm .AND. nprint > 2) WRITE( numond, nambdy_dta )
526
527	cn_dir_array(jbdy) = cn_dir
528	ln_full_vel_array(jbdy) = ln_full_vel
529
530	nblen => idx_bdy(jbdy)%nblen
531	nblenrim => idx_bdy(jbdy)%nblenrim
532	dta => dta_bdy(jbdy)
533	dta%nread(2) = 0
534
535	! Only read in necessary fields for this set.
536	! Important that barotropic variables come first.
537	IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN
538
539	IF( dta%ll_ssh ) THEN
540	IF(lwp) THEN
541	write(numout,*) '++++++ reading in ssh field'
542	IF(lflush) CALL FLUSH(numout)
543	ENDIF
544	jfld = jfld + 1
545	blf_i(jfld) = bn_ssh
546	ibdy(jfld) = jbdy
547	igrid(jfld) = 1
548	ilen1(jfld) = nblen(igrid(jfld))
549	ilen3(jfld) = 1
550	dta%nread(2) = dta%nread(2) + 1
551	ENDIF
552
553	IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN
554	IF(lwp) THEN
555	write(numout,*) '++++++ reading in u2d field'
556	IF(lflush) CALL FLUSH(numout)
557	ENDIF
558	jfld = jfld + 1
559	blf_i(jfld) = bn_u2d
560	ibdy(jfld) = jbdy
561	igrid(jfld) = 2
562	ilen1(jfld) = nblen(igrid(jfld))
563	ilen3(jfld) = 1
564	dta%nread(2) = dta%nread(2) + 1
565	ENDIF
566
567	IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN
568	IF(lwp) THEN
569	write(numout,*) '++++++ reading in v2d field'
570	IF(lflush) CALL FLUSH(numout)
571	ENDIF
572	jfld = jfld + 1
573	blf_i(jfld) = bn_v2d
574	ibdy(jfld) = jbdy
575	igrid(jfld) = 3
576	ilen1(jfld) = nblen(igrid(jfld))
577	ilen3(jfld) = 1
578	dta%nread(2) = dta%nread(2) + 1
579	ENDIF
580
581	ENDIF
582
583	! read 3D velocities if baroclinic velocities require OR if
584	! barotropic velocities required and ln_full_vel set to .true.
585	IF( nn_dyn3d_dta(jbdy) == 1 .OR. &
586	& ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN
587
588	IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN
589	IF(lwp) THEN
590	write(numout,*) '++++++ reading in u3d field'
591	IF(lflush) CALL FLUSH(numout)
592	ENDIF
593	jfld = jfld + 1
594	blf_i(jfld) = bn_u3d
595	ibdy(jfld) = jbdy
596	igrid(jfld) = 2
597	ilen1(jfld) = nblen(igrid(jfld))
598	ilen3(jfld) = jpk
599	IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1
600	ENDIF
601
602	IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN
603	IF(lwp) THEN
604	write(numout,*) '++++++ reading in v3d field'
605	IF(lflush) CALL FLUSH(numout)
606	ENDIF
607	jfld = jfld + 1
608	blf_i(jfld) = bn_v3d
609	ibdy(jfld) = jbdy
610	igrid(jfld) = 3
611	ilen1(jfld) = nblen(igrid(jfld))
612	ilen3(jfld) = jpk
613	IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1
614	ENDIF
615
616	ENDIF
617
618	! temperature and salinity
619	IF( nn_tra_dta(jbdy) == 1 ) THEN
620
621	IF( dta%ll_tem ) THEN
622	IF(lwp) THEN
623	write(numout,*) '++++++ reading in tem field'
624	IF(lflush) CALL FLUSH(numout)
625	ENDIF
626	jfld = jfld + 1
627	blf_i(jfld) = bn_tem
628	ibdy(jfld) = jbdy
629	igrid(jfld) = 1
630	ilen1(jfld) = nblen(igrid(jfld))
631	ilen3(jfld) = jpk
632	ENDIF
633
634	IF( dta%ll_sal ) THEN
635	IF(lwp) THEN
636	write(numout,*) '++++++ reading in sal field'
637	IF(lflush) CALL FLUSH(numout)
638	ENDIF
639	jfld = jfld + 1
640	blf_i(jfld) = bn_sal
641	ibdy(jfld) = jbdy
642	igrid(jfld) = 1
643	ilen1(jfld) = nblen(igrid(jfld))
644	ilen3(jfld) = jpk
645	ENDIF
646
647	ENDIF
648
649	#if defined key_si3
650	! sea ice
651	IF( nn_ice_dta(jbdy) == 1 ) THEN
652	! Test for types of ice input (1cat or Xcat)
653	! Build file name to find dimensions
654	clname=TRIM( cn_dir )//TRIM(bn_a_i%clname)
655	IF( .NOT. bn_a_i%ln_clim ) THEN
656	WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear ! add year
657	IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month
658	ELSE
659	IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth ! add month
660	ENDIF
661	IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) &
662	& WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day
663	!
664	CALL iom_open ( clname, inum )
665	id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. )
666	CALL iom_close ( inum )
667
668	IF ( kndims == 4 ) THEN
669	nice_cat = kdimsz(4) ! Xcat input
670	ELSE
671	nice_cat = 1 ! 1cat input
672	ENDIF
673	! End test
674
675	IF( dta%ll_a_i ) THEN
676	jfld = jfld + 1
677	blf_i(jfld) = bn_a_i
678	ibdy(jfld) = jbdy
679	igrid(jfld) = 1
680	ilen1(jfld) = nblen(igrid(jfld))
681	ilen3(jfld) = nice_cat
682	ENDIF
683
684	IF( dta%ll_h_i ) THEN
685	jfld = jfld + 1
686	blf_i(jfld) = bn_h_i
687	ibdy(jfld) = jbdy
688	igrid(jfld) = 1
689	ilen1(jfld) = nblen(igrid(jfld))
690	ilen3(jfld) = nice_cat
691	ENDIF
692
693	IF( dta%ll_h_s ) THEN
694	jfld = jfld + 1
695	blf_i(jfld) = bn_h_s
696	ibdy(jfld) = jbdy
697	igrid(jfld) = 1
698	ilen1(jfld) = nblen(igrid(jfld))
699	ilen3(jfld) = nice_cat
700	ENDIF
701
702	ENDIF
703	#endif
704	! Recalculate field counts
705	!-------------------------
706	IF( jbdy == 1 ) THEN
707	nb_bdy_fld_sum = 0
708	nb_bdy_fld(jbdy) = jfld
709	nb_bdy_fld_sum = jfld
710	ELSE
711	nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum
712	nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy)
713	ENDIF
714
715	dta%nread(1) = nb_bdy_fld(jbdy)
716
717	ENDIF ! nn_dta == 1
718	ENDDO ! jbdy
719
720	DO jfld = 1, nb_bdy_fld_sum
721	ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
722	IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
723	nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
724	nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld))
725	ENDDO
726
727	! fill bf with blf_i and control print
728	!-------------------------------------
729	jstart = 1
730	DO jbdy = 1, nb_bdy
731	jend = jstart - 1 + nb_bdy_fld(jbdy)
732	CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', &
733	& 'open boundary conditions', 'nambdy_dta' )
734	jstart = jend + 1
735	ENDDO
736
737	DO jfld = 1, nb_bdy_fld_sum
738	bf(jfld)%igrd = igrid(jfld)
739	bf(jfld)%ibdy = ibdy(jfld)
740	ENDDO
741
742	! Initialise local boundary data arrays
743	! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
744	! nn_xxx_dta=1 : point to "fnow" arrays
745	!-------------------------------------
746
747	jfld = 0
748	DO jbdy=1, nb_bdy
749
750	nblen => idx_bdy(jbdy)%nblen
751	dta => dta_bdy(jbdy)
752
753	if(lwp) then
754	write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh
755	write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d
756	write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d
757	write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d
758	write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d
759	write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem
760	write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal
761	IF(lflush) CALL FLUSH(numout)
762	endif
763
764	IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN
765	IF(lwp) THEN
766	write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space'
767	IF(lflush) CALL FLUSH(numout)
768	ENDIF
769	IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) )
770	IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) )
771	IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
772	ENDIF
773	IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN
774	IF( dta%ll_ssh ) THEN
775	IF(lwp) THEN
776	write(numout,*) '++++++ dta%ssh pointing to fnow'
777	IF(lflush) CALL FLUSH(numout)
778	ENDIF
779	jfld = jfld + 1
780	dta%ssh => bf(jfld)%fnow(:,1,1)
781	ENDIF
782	IF ( dta%ll_u2d ) THEN
783	IF ( ln_full_vel_array(jbdy) ) THEN
784	IF(lwp) THEN
785	write(numout,*) '++++++ dta%u2d allocated space'
786	IF(lflush) CALL FLUSH(numout)
787	ENDIF
788	ALLOCATE( dta%u2d(nblen(2)) )
789	ELSE
790	IF(lwp) THEN
791	write(numout,*) '++++++ dta%u2d pointing to fnow'
792	IF(lflush) CALL FLUSH(numout)
793	ENDIF
794	jfld = jfld + 1
795	dta%u2d => bf(jfld)%fnow(:,1,1)
796	ENDIF
797	ENDIF
798	IF ( dta%ll_v2d ) THEN
799	IF ( ln_full_vel_array(jbdy) ) THEN
800	IF(lwp) THEN
801	write(numout,*) '++++++ dta%v2d allocated space'
802	IF(lflush) CALL FLUSH(numout)
803	ENDIF
804	ALLOCATE( dta%v2d(nblen(3)) )
805	ELSE
806	IF(lwp) THEN
807	write(numout,*) '++++++ dta%v2d pointing to fnow'
808	IF(lflush) CALL FLUSH(numout)
809	ENDIF
810	jfld = jfld + 1
811	dta%v2d => bf(jfld)%fnow(:,1,1)
812	ENDIF
813	ENDIF
814	ENDIF
815
816	IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN
817	IF(lwp) THEN
818	write(numout,*) '++++++ dta%u3d/v3d allocated space'
819	IF(lflush) CALL FLUSH(numout)
820	ENDIF
821	IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) )
822	IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) )
823	ENDIF
824	IF ( nn_dyn3d_dta(jbdy) == 1 .or. &
825	& ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN
826	IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN
827	IF(lwp) THEN
828	write(numout,*) '++++++ dta%u3d pointing to fnow'
829	IF(lflush) CALL FLUSH(numout)
830	ENDIF
831	jfld = jfld + 1
832	dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:)
833	ENDIF
834	IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN
835	IF(lwp) THEN
836	write(numout,*) '++++++ dta%v3d pointing to fnow'
837	IF(lflush) CALL FLUSH(numout)
838	ENDIF
839	jfld = jfld + 1
840	dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:)
841	ENDIF
842	ENDIF
843
844	IF( nn_tra_dta(jbdy) == 0 ) THEN
845	IF(lwp) THEN
846	write(numout,*) '++++++ dta%tem/sal allocated space'
847	IF(lflush) CALL FLUSH(numout)
848	ENDIF
849	IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) )
850	IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) )
851	ELSE
852	IF( dta%ll_tem ) THEN
853	IF(lwp) THEN
854	write(numout,*) '++++++ dta%tem pointing to fnow'
855	IF(lflush) CALL FLUSH(numout)
856	ENDIF
857	jfld = jfld + 1
858	dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:)
859	ENDIF
860	IF( dta%ll_sal ) THEN
861	IF(lwp) THEN
862	write(numout,*) '++++++ dta%sal pointing to fnow'
863	IF(lflush) CALL FLUSH(numout)
864	ENDIF
865	jfld = jfld + 1
866	dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:)
867	ENDIF
868	ENDIF
869
870	#if defined key_si3
871	IF (cn_ice(jbdy) /= 'none') THEN
872	IF( nn_ice_dta(jbdy) == 0 ) THEN
873	ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) )
874	ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) )
875	ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) )
876	ELSE
877	IF ( nice_cat == jpl ) THEN ! case input cat = jpl
878	jfld = jfld + 1
879	dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:)
880	jfld = jfld + 1
881	dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:)
882	jfld = jfld + 1
883	dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:)
884	ELSE ! case input cat = 1 OR (/=1 and /=jpl)
885	jfld_ait(jbdy) = jfld + 1
886	jfld_htit(jbdy) = jfld + 2
887	jfld_htst(jbdy) = jfld + 3
888	jfld = jfld + 3
889	ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) )
890	ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) )
891	ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) )
892	dta_bdy(jbdy)%a_i(:,:) = 0._wp
893	dta_bdy(jbdy)%h_i(:,:) = 0._wp
894	dta_bdy(jbdy)%h_s(:,:) = 0._wp
895	ENDIF
896
897	ENDIF
898	ENDIF
899	#endif
900	!
901	END DO ! jbdy
902	!
903	END SUBROUTINE bdy_dta_init
904
905	!!==============================================================================
906	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/branches/UKMO/NEMO_4.0_mirror_text_diagnostics/src/OCE/BDY/bdydta.F90 @ 10986

Download in other formats: