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/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Context Navigation

source: branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 @ 4332

Last change on this file since 4332 was 4332, checked in by clem, 10 years ago
update LIM3 to fix remaining bugs. Now working in global and regional config.
Property svn:keywords set to `Id`
File size: 38.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	!! - ! 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 wrk_nemo ! Memory Allocation
23	USE timing ! Timing
24	USE oce ! ocean dynamics and tracers
25	USE dom_oce ! ocean space and time domain
26	USE phycst ! physical constants
27	USE bdy_oce ! ocean open boundary conditions
28	USE bdytides ! tidal forcing at boundaries
29	USE fldread ! read input fields
30	USE iom ! IOM library
31	USE in_out_manager ! I/O logical units
32	#if defined key_lim2
33	USE ice_2
34	#elif defined key_lim3
35	USE par_ice
36	USE ice
37	USE limcat_1D ! redistribute ice input into categories
38	#endif
39	USE sbcapr
40
41	IMPLICIT NONE
42	PRIVATE
43
44	PUBLIC bdy_dta ! routine called by step.F90 and dynspg_ts.F90
45	PUBLIC bdy_dta_init ! routine called by nemogcm.F90
46
47	INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_bdy_fld ! Number of fields to update for each boundary set.
48	INTEGER :: nb_bdy_fld_sum ! Total number of fields to update for all boundary sets.
49
50	LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions
51	! =F => baroclinic velocities in 3D boundary conditions
52
53	TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: bf ! structure of input fields (file informations, fields read)
54
55	TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap
56
57	#if defined key_lim3
58	LOGICAL :: ll_bdylim3 ! determine whether ice input is lim2 (F) or lim3 (T) type
59	INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure
60	#endif
61
62	# include "domzgr_substitute.h90"
63	!!----------------------------------------------------------------------
64	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
65	!! $Id$
66	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
67	!!----------------------------------------------------------------------
68	CONTAINS
69
70	SUBROUTINE bdy_dta( kt, jit, time_offset )
71	!!----------------------------------------------------------------------
72	!! * SUBROUTINE bdy_dta *
73	!!
74	!! ** Purpose : Update external data for open boundary conditions
75	!!
76	!! ** Method : Use fldread.F90
77	!!
78	!!----------------------------------------------------------------------
79	!!
80	INTEGER, INTENT( in ) :: kt ! ocean time-step index
81	INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)
82	INTEGER, INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit
83	! is present then units = subcycle timesteps.
84	! time_offset = 0 => get data at "now" time level
85	! time_offset = -1 => get data at "before" time level
86	! time_offset = +1 => get data at "after" time level
87	! etc.
88	!!
89	INTEGER :: ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl ! local indices
90	INTEGER, DIMENSION(jpbgrd) :: ilen1
91	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
92	!!
93	!!---------------------------------------------------------------------------
94	!!
95	IF( nn_timing == 1 ) CALL timing_start('bdy_dta')
96
97	! Initialise data arrays once for all from initial conditions where required
98	!---------------------------------------------------------------------------
99	IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN
100
101	! Calculate depth-mean currents
102	!-----------------------------
103	CALL wrk_alloc(jpi,jpj,pu2d,pv2d)
104
105	pu2d(:,:) = 0.e0
106	pv2d(:,:) = 0.e0
107
108	DO ik = 1, jpkm1 !! Vertically integrated momentum trends
109	pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik)
110	pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik)
111	END DO
112	pu2d(:,:) = pu2d(:,:) * hur(:,:)
113	pv2d(:,:) = pv2d(:,:) * hvr(:,:)
114
115	DO ib_bdy = 1, nb_bdy
116
117	nblen => idx_bdy(ib_bdy)%nblen
118	nblenrim => idx_bdy(ib_bdy)%nblenrim
119
120	IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN
121	ilen1(:) = nblen(:)
122	igrd = 1
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)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)
127	END DO
128	igrd = 2
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)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)
133	END DO
134	igrd = 3
135	DO ib = 1, ilen1(igrd)
136	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
137	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
138	dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)
139	END DO
140	ENDIF
141
142	IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
143	ilen1(:) = nblen(:)
144	igrd = 2
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)%u3d(ib,ik) = ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)
150	END DO
151	END DO
152	igrd = 3
153	DO ib = 1, ilen1(igrd)
154	DO ik = 1, jpkm1
155	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
156	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
157	dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik)
158	END DO
159	END DO
160	ENDIF
161
162	IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN
163	ilen1(:) = nblen(:)
164	igrd = 1 ! Everything is at T-points here
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	dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)
171	END DO
172	END DO
173	ENDIF
174
175	#if defined key_lim2
176	IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
177	ilen1(:) = nblen(:)
178	igrd = 1 ! Everything is at T-points here
179	DO ib = 1, ilen1(igrd)
180	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
181	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
182	dta_bdy(ib_bdy)%frld (ib) = frld(ii,ij) * tmask(ii,ij,1)
183	dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)
184	dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)
185	END DO
186	ENDIF
187	#elif defined key_lim3
188	IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
189	ilen1(:) = nblen(:)
190	igrd = 1 ! Everything is at T-points here
191	DO jl = 1, jpl
192	DO ib = 1, ilen1(igrd)
193	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
194	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
195	dta_bdy(ib_bdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1)
196	dta_bdy(ib_bdy)%ht_i(ib,jl) = ht_i(ii,ij,jl) * tmask(ii,ij,1)
197	dta_bdy(ib_bdy)%ht_s(ib,jl) = ht_s(ii,ij,jl) * tmask(ii,ij,1)
198	END DO
199	END DO
200	ENDIF
201	#endif
202
203	ENDDO ! ib_bdy
204
205	CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)
206
207	ENDIF ! kt .eq. nit000
208
209	! update external data from files
210	!--------------------------------
211
212	jstart = 1
213	DO ib_bdy = 1, nb_bdy
214	IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required
215
216	IF( PRESENT(jit) ) THEN
217	! Update barotropic boundary conditions only
218	! jit is optional argument for fld_read and bdytide_update
219	IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN
220	IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
221	dta_bdy(ib_bdy)%ssh(:) = 0.0
222	dta_bdy(ib_bdy)%u2d(:) = 0.0
223	dta_bdy(ib_bdy)%v2d(:) = 0.0
224	ENDIF
225	IF (nn_tra(ib_bdy).ne.4) THEN
226	IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. &
227	& (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN
228
229	! For the runoff case, no need to update the forcing (already done in the baroclinic part)
230	jend = nb_bdy_fld(ib_bdy)
231	IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2
232	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), &
233	& kit=jit, kt_offset=time_offset )
234	IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2
235
236	! If full velocities in boundary data then split into barotropic and baroclinic data
237	IF( ln_full_vel_array(ib_bdy) .AND. &
238	& ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. &
239	& nn_dyn3d_dta(ib_bdy) .EQ. 1 ) )THEN
240
241	igrd = 2 ! zonal velocity
242	dta_bdy(ib_bdy)%u2d(:) = 0.0
243	DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
244	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
245	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
246	DO ik = 1, jpkm1
247	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
248	& + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
249	END DO
250	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
251	DO ik = 1, jpkm1
252	dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)
253	END DO
254	END DO
255	igrd = 3 ! meridional velocity
256	dta_bdy(ib_bdy)%v2d(:) = 0.0
257	DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
258	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
259	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
260	DO ik = 1, jpkm1
261	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
262	& + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
263	END DO
264	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
265	DO ik = 1, jpkm1
266	dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)
267	END DO
268	END DO
269	ENDIF
270	ENDIF
271	IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
272	CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), &
273	& jit=jit, time_offset=time_offset )
274	ENDIF
275	ENDIF
276	ENDIF
277	ELSE
278	IF (nn_tra(ib_bdy).eq.4) then ! runoff condition
279	jend = nb_bdy_fld(ib_bdy)
280	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
281	& map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
282	!
283	igrd = 2 ! zonal velocity
284	DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
285	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
286	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
287	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
288	END DO
289	!
290	igrd = 3 ! meridional velocity
291	DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
292	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
293	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
294	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
295	END DO
296	ELSE
297	IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
298	dta_bdy(ib_bdy)%ssh(:) = 0.0
299	dta_bdy(ib_bdy)%u2d(:) = 0.0
300	dta_bdy(ib_bdy)%v2d(:) = 0.0
301	ENDIF
302	IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data
303	jend = nb_bdy_fld(ib_bdy)
304	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
305	& map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
306	ENDIF
307	! If full velocities in boundary data then split into barotropic and baroclinic data
308	IF( ln_full_vel_array(ib_bdy) .and. &
309	& ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. &
310	& nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN
311	igrd = 2 ! zonal velocity
312	dta_bdy(ib_bdy)%u2d(:) = 0.0
313	DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
314	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
315	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
316	DO ik = 1, jpkm1
317	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
318	& + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
319	END DO
320	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
321	DO ik = 1, jpkm1
322	dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)
323	END DO
324	END DO
325	igrd = 3 ! meridional velocity
326	dta_bdy(ib_bdy)%v2d(:) = 0.0
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	DO ik = 1, jpkm1
331	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
332	& + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
333	END DO
334	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
335	DO ik = 1, jpkm1
336	dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)
337	END DO
338	END DO
339	ENDIF
340	IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
341	CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), &
342	& td=tides(ib_bdy), time_offset=time_offset )
343	ENDIF
344	ENDIF
345	#if defined key_lim3
346	IF( .NOT. ll_bdylim3 .AND. nn_ice_lim(ib_bdy) > 0 .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)
347	CALL lim_cat_1D ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
348	& dta_bdy(ib_bdy)%ht_i, dta_bdy(ib_bdy)%ht_s, dta_bdy(ib_bdy)%a_i )
349	ENDIF
350	#endif
351
352	ENDIF
353	jstart = jend+1
354	END IF ! nn_dta(ib_bdy) = 1
355	END DO ! ib_bdy
356
357	IF ( ln_apr_obc ) THEN
358	DO ib_bdy = 1, nb_bdy
359	IF (nn_tra(ib_bdy).NE.4)THEN
360	igrd = 1 ! meridional velocity
361	DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
362	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
363	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
364	dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij)
365	ENDDO
366	ENDIF
367	ENDDO
368	ENDIF
369
370	IF( nn_timing == 1 ) CALL timing_stop('bdy_dta')
371
372	END SUBROUTINE bdy_dta
373
374
375	SUBROUTINE bdy_dta_init
376	!!----------------------------------------------------------------------
377	!! * SUBROUTINE bdy_dta_init *
378	!!
379	!! ** Purpose : Initialise arrays for reading of external data
380	!! for open boundary conditions
381	!!
382	!! ** Method : Use fldread.F90
383	!!
384	!!----------------------------------------------------------------------
385	USE dynspg_oce, ONLY: lk_dynspg_ts
386	!!
387	INTEGER :: ib_bdy, jfld, jstart, jend, ierror ! local indices
388	!!
389	CHARACTER(len=100) :: cn_dir ! Root directory for location of data files
390	CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files
391	LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data
392	! =F => baroclinic velocities in 3D boundary data
393	INTEGER :: ilen_global ! Max length required for global bdy dta arrays
394	INTEGER, DIMENSION(jpbgrd) :: ilen0 ! size of local arrays
395	INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays
396	INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld
397	INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V)
398	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
399	#if defined key_lim3
400	INTEGER, DIMENSION(3) :: zdimsz ! number of elements in each of the 4 dimensions (i.e. i,j,t,ice-cat) for an array
401	INTEGER :: zndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)
402	INTEGER :: inum,id1 ! local integer
403	#endif
404	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures
405	TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d !
406	TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read
407	#if defined key_lim2
408	TYPE(FLD_N) :: bn_frld, bn_hicif, bn_hsnif
409	#elif defined key_lim3
410	TYPE(FLD_N) :: bn_a_i, bn_ht_i, bn_ht_s
411	#endif
412	NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d
413	#if defined key_lim2
414	NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif
415	#elif defined key_lim3
416	NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s
417	#endif
418	NAMELIST/nambdy_dta/ ln_full_vel
419	!!---------------------------------------------------------------------------
420
421	IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')
422
423	IF(lwp) WRITE(numout,*)
424	IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
425	IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
426	IF(lwp) WRITE(numout,*) ''
427
428	! Set nn_dta
429	DO ib_bdy = 1, nb_bdy
430	nn_dta(ib_bdy) = MAX( nn_dyn2d_dta(ib_bdy) &
431	,nn_dyn3d_dta(ib_bdy) &
432	,nn_tra_dta(ib_bdy) &
433	#if ( defined key_lim2 \|\| defined key_lim3 )
434	,nn_ice_lim_dta(ib_bdy) &
435	#endif
436	)
437	IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1
438	END DO
439
440	! Work out upper bound of how many fields there are to read in and allocate arrays
441	! ---------------------------------------------------------------------------
442	ALLOCATE( nb_bdy_fld(nb_bdy) )
443	nb_bdy_fld(:) = 0
444	DO ib_bdy = 1, nb_bdy
445	IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
446	nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
447	ENDIF
448	IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN
449	nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
450	ENDIF
451	IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN
452	nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
453	ENDIF
454	#if ( defined key_lim2 \|\| defined key_lim3 )
455	IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
456	nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
457	ENDIF
458	#endif
459	IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy)
460	ENDDO
461
462	nb_bdy_fld_sum = SUM( nb_bdy_fld )
463
464	ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
465	IF( ierror > 0 ) THEN
466	CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN
467	ENDIF
468	ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
469	IF( ierror > 0 ) THEN
470	CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN
471	ENDIF
472	ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
473	IF( ierror > 0 ) THEN
474	CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN
475	ENDIF
476	ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )
477	ALLOCATE( ibdy(nb_bdy_fld_sum) )
478	ALLOCATE( igrid(nb_bdy_fld_sum) )
479
480	! Read namelists
481	! --------------
482	REWIND(numnam)
483	jfld = 0
484	DO ib_bdy = 1, nb_bdy
485	IF( nn_dta(ib_bdy) .eq. 1 ) THEN
486	! set file information
487	cn_dir = './' ! directory in which the model is executed
488	ln_full_vel = .false.
489	! ... default values (NB: frequency positive => hours, negative => months)
490	! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !
491	! ! name ! hours ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !
492	bn_ssh = FLD_N( 'bdy_ssh' , 24 , 'sossheig' , .false. , .false. , 'yearly' , '' , '' )
493	bn_u2d = FLD_N( 'bdy_vel2d_u' , 24 , 'vobtcrtx' , .false. , .false. , 'yearly' , '' , '' )
494	bn_v2d = FLD_N( 'bdy_vel2d_v' , 24 , 'vobtcrty' , .false. , .false. , 'yearly' , '' , '' )
495	bn_u3d = FLD_N( 'bdy_vel3d_u' , 24 , 'vozocrtx' , .false. , .false. , 'yearly' , '' , '' )
496	bn_v3d = FLD_N( 'bdy_vel3d_v' , 24 , 'vomecrty' , .false. , .false. , 'yearly' , '' , '' )
497	bn_tem = FLD_N( 'bdy_tem' , 24 , 'votemper' , .false. , .false. , 'yearly' , '' , '' )
498	bn_sal = FLD_N( 'bdy_sal' , 24 , 'vosaline' , .false. , .false. , 'yearly' , '' , '' )
499	#if defined key_lim2
500	bn_frld = FLD_N( 'bdy_frld' , 24 , 'ildsconc' , .false. , .false. , 'yearly' , '' , '' )
501	bn_hicif = FLD_N( 'bdy_hicif' , 24 , 'iicethic' , .false. , .false. , 'yearly' , '' , '' )
502	bn_hsnif = FLD_N( 'bdy_hsnif' , 24 , 'isnothic' , .false. , .false. , 'yearly' , '' , '' )
503	#elif defined key_lim3
504	bn_a_i = FLD_N( 'bdy_a_i' , 24 , 'ileadfra' , .false. , .false. , 'yearly' , '' , '' )
505	bn_ht_i = FLD_N( 'bdy_ht_i' , 24 , 'iicethic' , .false. , .false. , 'yearly' , '' , '' )
506	bn_ht_s = FLD_N( 'bdy_ht_s' , 24 , 'isnowthi' , .false. , .false. , 'yearly' , '' , '' )
507	#endif
508
509	! Important NOT to rewind here.
510	READ( numnam, nambdy_dta )
511
512	cn_dir_array(ib_bdy) = cn_dir
513	ln_full_vel_array(ib_bdy) = ln_full_vel
514
515	nblen => idx_bdy(ib_bdy)%nblen
516	nblenrim => idx_bdy(ib_bdy)%nblenrim
517
518	! Only read in necessary fields for this set.
519	! Important that barotropic variables come first.
520	IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
521
522	IF( nn_dyn2d(ib_bdy) .ne. jp_frs .and. nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading
523	jfld = jfld + 1
524	blf_i(jfld) = bn_ssh
525	ibdy(jfld) = ib_bdy
526	igrid(jfld) = 1
527	ilen1(jfld) = nblen(igrid(jfld))
528	ilen3(jfld) = 1
529	ENDIF
530
531	IF( .not. ln_full_vel_array(ib_bdy) ) THEN
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
539	jfld = jfld + 1
540	blf_i(jfld) = bn_v2d
541	ibdy(jfld) = ib_bdy
542	igrid(jfld) = 3
543	ilen1(jfld) = nblen(igrid(jfld))
544	ilen3(jfld) = 1
545	ENDIF
546
547	ENDIF
548
549	! baroclinic velocities
550	IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. &
551	& ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. &
552	& ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
553
554	jfld = jfld + 1
555	blf_i(jfld) = bn_u3d
556	ibdy(jfld) = ib_bdy
557	igrid(jfld) = 2
558	ilen1(jfld) = nblen(igrid(jfld))
559	ilen3(jfld) = jpk
560
561	jfld = jfld + 1
562	blf_i(jfld) = bn_v3d
563	ibdy(jfld) = ib_bdy
564	igrid(jfld) = 3
565	ilen1(jfld) = nblen(igrid(jfld))
566	ilen3(jfld) = jpk
567
568	ENDIF
569
570	! temperature and salinity
571	IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN
572
573	jfld = jfld + 1
574	blf_i(jfld) = bn_tem
575	ibdy(jfld) = ib_bdy
576	igrid(jfld) = 1
577	ilen1(jfld) = nblen(igrid(jfld))
578	ilen3(jfld) = jpk
579
580	jfld = jfld + 1
581	blf_i(jfld) = bn_sal
582	ibdy(jfld) = ib_bdy
583	igrid(jfld) = 1
584	ilen1(jfld) = nblen(igrid(jfld))
585	ilen3(jfld) = jpk
586
587	ENDIF
588
589	#if defined key_lim2
590	! sea ice
591	IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
592
593	jfld = jfld + 1
594	blf_i(jfld) = bn_frld
595	ibdy(jfld) = ib_bdy
596	igrid(jfld) = 1
597	ilen1(jfld) = nblen(igrid(jfld))
598	ilen3(jfld) = 1
599
600	jfld = jfld + 1
601	blf_i(jfld) = bn_hicif
602	ibdy(jfld) = ib_bdy
603	igrid(jfld) = 1
604	ilen1(jfld) = nblen(igrid(jfld))
605	ilen3(jfld) = 1
606
607	jfld = jfld + 1
608	blf_i(jfld) = bn_hsnif
609	ibdy(jfld) = ib_bdy
610	igrid(jfld) = 1
611	ilen1(jfld) = nblen(igrid(jfld))
612	ilen3(jfld) = 1
613
614	ENDIF
615	#elif defined key_lim3
616	! sea ice
617	IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
618
619	! Test for types of ice input (lim2 or lim3)
620	CALL iom_open ( bn_a_i%clname, inum )
621	id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
622	CALL iom_close ( inum )
623	!CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. )
624	!CALL iom_open ( bn_a_i%clname, inum )
625	!id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
626	IF ( zndims == 4 ) THEN
627	ll_bdylim3 = .TRUE. ! lim3 input
628	ELSE
629	ll_bdylim3 = .FALSE. ! lim2 input
630	ENDIF
631	! End test
632
633	jfld = jfld + 1
634	blf_i(jfld) = bn_a_i
635	ibdy(jfld) = ib_bdy
636	igrid(jfld) = 1
637	ilen1(jfld) = nblen(igrid(jfld))
638	IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
639
640	jfld = jfld + 1
641	blf_i(jfld) = bn_ht_i
642	ibdy(jfld) = ib_bdy
643	igrid(jfld) = 1
644	ilen1(jfld) = nblen(igrid(jfld))
645	IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
646
647	jfld = jfld + 1
648	blf_i(jfld) = bn_ht_s
649	ibdy(jfld) = ib_bdy
650	igrid(jfld) = 1
651	ilen1(jfld) = nblen(igrid(jfld))
652	IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
653
654	ENDIF
655	#endif
656	! Recalculate field counts
657	!-------------------------
658	IF( ib_bdy .eq. 1 ) THEN
659	nb_bdy_fld_sum = 0
660	nb_bdy_fld(ib_bdy) = jfld
661	nb_bdy_fld_sum = jfld
662	ELSE
663	nb_bdy_fld(ib_bdy) = jfld - nb_bdy_fld_sum
664	nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(ib_bdy)
665	ENDIF
666
667	ENDIF ! nn_dta .eq. 1
668	ENDDO ! ib_bdy
669
670	DO jfld = 1, nb_bdy_fld_sum
671	ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
672	IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
673	nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
674	ENDDO
675
676	! fill bf with blf_i and control print
677	!-------------------------------------
678	jstart = 1
679	DO ib_bdy = 1, nb_bdy
680	jend = nb_bdy_fld(ib_bdy)
681	CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta', &
682	& 'open boundary conditions', 'nambdy_dta' )
683	jstart = jend + 1
684	ENDDO
685
686	! Initialise local boundary data arrays
687	! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
688	! nn_xxx_dta=1 : point to "fnow" arrays
689	!-------------------------------------
690
691	jfld = 0
692	DO ib_bdy=1, nb_bdy
693
694	nblen => idx_bdy(ib_bdy)%nblen
695	nblenrim => idx_bdy(ib_bdy)%nblenrim
696
697	IF (nn_dyn2d(ib_bdy) .gt. 0) THEN
698	IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN
699	ilen0(1:3) = nblen(1:3)
700	ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) )
701	ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) )
702	IF ( nn_dyn2d(ib_bdy) .ne. jp_frs .and. (nn_dyn2d_dta(ib_bdy).eq.1.or.nn_dyn2d_dta(ib_bdy).eq.3) ) THEN
703	jfld = jfld + 1
704	dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1)
705	ELSE
706	ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) )
707	ENDIF
708	ELSE
709	IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
710	jfld = jfld + 1
711	dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1)
712	ENDIF
713	jfld = jfld + 1
714	dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1)
715	jfld = jfld + 1
716	dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1)
717	ENDIF
718	ENDIF
719
720	IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
721	ilen0(1:3) = nblen(1:3)
722	ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) )
723	ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) )
724	ENDIF
725	IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. &
726	& ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. &
727	& ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
728	jfld = jfld + 1
729	dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:)
730	jfld = jfld + 1
731	dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:)
732	ENDIF
733
734	IF (nn_tra(ib_bdy) .gt. 0) THEN
735	IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
736	ilen0(1:3) = nblen(1:3)
737	ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) )
738	ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) )
739	ELSE
740	jfld = jfld + 1
741	dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:)
742	jfld = jfld + 1
743	dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:)
744	ENDIF
745	ENDIF
746
747	#if defined key_lim2
748	IF (nn_ice_lim(ib_bdy) .gt. 0) THEN
749	IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
750	ilen0(1:3) = nblen(1:3)
751	ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) )
752	ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) )
753	ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) )
754	ELSE
755	jfld = jfld + 1
756	dta_bdy(ib_bdy)%frld => bf(jfld)%fnow(:,1,1)
757	jfld = jfld + 1
758	dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1)
759	jfld = jfld + 1
760	dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1)
761	ENDIF
762	ENDIF
763	#elif defined key_lim3
764	IF (nn_ice_lim(ib_bdy) .gt. 0) THEN
765	ilen0(1:3) = nblen(1:3)
766	IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
767	ALLOCATE( dta_bdy(ib_bdy)%a_i (ilen0(1),jpl) )
768	ALLOCATE( dta_bdy(ib_bdy)%ht_i(ilen0(1),jpl) )
769	ALLOCATE( dta_bdy(ib_bdy)%ht_s(ilen0(1),jpl) )
770	ELSE
771	IF ( ll_bdylim3 ) THEN ! case input is lim3 type
772	jfld = jfld + 1
773	dta_bdy(ib_bdy)%a_i => bf(jfld)%fnow(:,1,:)
774	jfld = jfld + 1
775	dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:)
776	jfld = jfld + 1
777	dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:)
778	ELSE ! case input is lim2 type
779	jfld_ai = jfld + 1
780	jfld_hti = jfld + 2
781	jfld_hts = jfld + 3
782	jfld = jfld + 3
783	ALLOCATE( dta_bdy(ib_bdy)%a_i (ilen0(1),jpl) )
784	ALLOCATE( dta_bdy(ib_bdy)%ht_i(ilen0(1),jpl) )
785	ALLOCATE( dta_bdy(ib_bdy)%ht_s(ilen0(1),jpl) )
786	dta_bdy(ib_bdy)%a_i (:,:) = 0.0
787	dta_bdy(ib_bdy)%ht_i(:,:) = 0.0
788	dta_bdy(ib_bdy)%ht_s(:,:) = 0.0
789	ENDIF
790
791	ENDIF
792	ENDIF
793	#endif
794
795	ENDDO ! ib_bdy
796
797	IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
798
799	END SUBROUTINE bdy_dta_init
800
801	#else
802	!!----------------------------------------------------------------------
803	!! Dummy module NO Open Boundary Conditions
804	!!----------------------------------------------------------------------
805	CONTAINS
806	SUBROUTINE bdy_dta( kt, jit, time_offset ) ! Empty routine
807	INTEGER, INTENT( in ) :: kt
808	INTEGER, INTENT( in ), OPTIONAL :: jit
809	INTEGER, INTENT( in ), OPTIONAL :: time_offset
810	WRITE(,) 'bdy_dta: You should not have seen this print! error?', kt
811	END SUBROUTINE bdy_dta
812	SUBROUTINE bdy_dta_init() ! Empty routine
813	WRITE(,) 'bdy_dta_init: You should not have seen this print! error?'
814	END SUBROUTINE bdy_dta_init
815	#endif
816
817	!!==============================================================================
818	END MODULE bdydta

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

Download in other formats: