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 NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/BDY – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/BDY/bdydta.F90 @ 11574

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

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

Download in other formats: