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/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Context Navigation

source: branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 @ 5902

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

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

Download in other formats: