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_r12072_MERGE_OPTION2_2019/src/OCE/BDY – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/BDY/bdydta.F90 @ 12246

Last change on this file since 12246 was 12246, checked in by smasson, 4 years ago
rev12232_dev_r12072_MERGE_OPTION2_2019: add modifications from dev_r12114_ticket_2263, results unchanged except SPITZ12 as explained in #2263
Property svn:keywords set to `Id`
File size: 39.5 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 , PARAMETER :: jpbdyfld = 16 ! maximum number of files to read
46	INTEGER , PARAMETER :: jp_bdyssh = 1 !
47	INTEGER , PARAMETER :: jp_bdyu2d = 2 !
48	INTEGER , PARAMETER :: jp_bdyv2d = 3 !
49	INTEGER , PARAMETER :: jp_bdyu3d = 4 !
50	INTEGER , PARAMETER :: jp_bdyv3d = 5 !
51	INTEGER , PARAMETER :: jp_bdytem = 6 !
52	INTEGER , PARAMETER :: jp_bdysal = 7 !
53	INTEGER , PARAMETER :: jp_bdya_i = 8 !
54	INTEGER , PARAMETER :: jp_bdyh_i = 9 !
55	INTEGER , PARAMETER :: jp_bdyh_s = 10 !
56	INTEGER , PARAMETER :: jp_bdyt_i = 11 !
57	INTEGER , PARAMETER :: jp_bdyt_s = 12 !
58	INTEGER , PARAMETER :: jp_bdytsu = 13 !
59	INTEGER , PARAMETER :: jp_bdys_i = 14 !
60	INTEGER , PARAMETER :: jp_bdyaip = 15 !
61	INTEGER , PARAMETER :: jp_bdyhip = 16 !
62	#if ! defined key_si3
63	INTEGER , PARAMETER :: jpl = 1
64	#endif
65
66	!$AGRIF_DO_NOT_TREAT
67	TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: bf ! structure of input fields (file informations, fields read)
68	!$AGRIF_END_DO_NOT_TREAT
69
70	!!----------------------------------------------------------------------
71	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
72	!! $Id$
73	!! Software governed by the CeCILL license (see ./LICENSE)
74	!!----------------------------------------------------------------------
75	CONTAINS
76
77	SUBROUTINE bdy_dta( kt, pt_offset )
78	!!----------------------------------------------------------------------
79	!! * SUBROUTINE bdy_dta *
80	!!
81	!! ** Purpose : Update external data for open boundary conditions
82	!!
83	!! ** Method : Use fldread.F90
84	!!
85	!!----------------------------------------------------------------------
86	INTEGER, INTENT(in) :: kt ! ocean time-step index
87	REAL(wp),INTENT(in), OPTIONAL :: pt_offset ! time offset in units of timesteps
88	!
89	INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices
90	INTEGER :: ii, ij, ik, igrd, ipl ! local integers
91	INTEGER, DIMENSION(jpbgrd) :: ilen1
92	INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts
93	TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut
94	TYPE(FLD), DIMENSION(:), POINTER :: bf_alias
95	!!---------------------------------------------------------------------------
96	!
97	IF( ln_timing ) CALL timing_start('bdy_dta')
98	!
99	! Initialise data arrays once for all from initial conditions where required
100	!---------------------------------------------------------------------------
101	IF( kt == nit000 ) THEN
102
103	! Calculate depth-mean currents
104	!-----------------------------
105
106	DO jbdy = 1, nb_bdy
107	!
108	nblen => idx_bdy(jbdy)%nblen
109	nblenrim => idx_bdy(jbdy)%nblenrim
110	!
111	IF( nn_dyn2d_dta(jbdy) == 0 ) THEN
112	ilen1(:) = nblen(:)
113	IF( dta_bdy(jbdy)%lneed_ssh ) THEN
114	igrd = 1
115	DO ib = 1, ilen1(igrd)
116	ii = idx_bdy(jbdy)%nbi(ib,igrd)
117	ij = idx_bdy(jbdy)%nbj(ib,igrd)
118	dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)
119	END DO
120	ENDIF
121	IF( dta_bdy(jbdy)%lneed_dyn2d) THEN
122	igrd = 2
123	DO ib = 1, ilen1(igrd)
124	ii = idx_bdy(jbdy)%nbi(ib,igrd)
125	ij = idx_bdy(jbdy)%nbj(ib,igrd)
126	dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)
127	END DO
128	igrd = 3
129	DO ib = 1, ilen1(igrd)
130	ii = idx_bdy(jbdy)%nbi(ib,igrd)
131	ij = idx_bdy(jbdy)%nbj(ib,igrd)
132	dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)
133	END DO
134	ENDIF
135	ENDIF
136	!
137	IF( nn_dyn3d_dta(jbdy) == 0 ) THEN
138	ilen1(:) = nblen(:)
139	IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN
140	igrd = 2
141	DO ib = 1, ilen1(igrd)
142	DO ik = 1, jpkm1
143	ii = idx_bdy(jbdy)%nbi(ib,igrd)
144	ij = idx_bdy(jbdy)%nbj(ib,igrd)
145	dta_bdy(jbdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)
146	END DO
147	END DO
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_bdy(jbdy)%lneed_tra ) 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	dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)
169	END DO
170	END DO
171	ENDIF
172	ENDIF
173
174	#if defined key_si3
175	IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values
176	ilen1(:) = nblen(:)
177	IF( dta_bdy(jbdy)%lneed_ice ) THEN
178	igrd = 1
179	DO jl = 1, jpl
180	DO ib = 1, ilen1(igrd)
181	ii = idx_bdy(jbdy)%nbi(ib,igrd)
182	ij = idx_bdy(jbdy)%nbj(ib,igrd)
183	dta_bdy(jbdy)%a_i(ib,jl) = a_i (ii,ij,jl) * tmask(ii,ij,1)
184	dta_bdy(jbdy)%h_i(ib,jl) = h_i (ii,ij,jl) * tmask(ii,ij,1)
185	dta_bdy(jbdy)%h_s(ib,jl) = h_s (ii,ij,jl) * tmask(ii,ij,1)
186	dta_bdy(jbdy)%t_i(ib,jl) = SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1)
187	dta_bdy(jbdy)%t_s(ib,jl) = SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1)
188	dta_bdy(jbdy)%tsu(ib,jl) = t_su(ii,ij,jl) * tmask(ii,ij,1)
189	dta_bdy(jbdy)%s_i(ib,jl) = s_i (ii,ij,jl) * tmask(ii,ij,1)
190	! melt ponds
191	dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1)
192	dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1)
193	END DO
194	END DO
195	ENDIF
196	ENDIF
197	#endif
198	END DO ! jbdy
199	!
200	ENDIF ! kt == nit000
201
202	! update external data from files
203	!--------------------------------
204
205	DO jbdy = 1, nb_bdy
206
207	dta_alias => dta_bdy(jbdy)
208	bf_alias => bf(:,jbdy)
209
210	! read/update all bdy data
211	! ------------------------
212	CALL fld_read( kt, 1, bf_alias, pt_offset = pt_offset )
213
214	! apply some corrections in some specific cases...
215	! --------------------------------------------------
216	!
217	! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s)
218	IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d
219	!
220	igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s)
221	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
222	ii = idx_bdy(jbdy)%nbi(ib,igrd)
223	ij = idx_bdy(jbdy)%nbj(ib,igrd)
224	dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
225	END DO
226	igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s)
227	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
228	ii = idx_bdy(jbdy)%nbi(ib,igrd)
229	ij = idx_bdy(jbdy)%nbj(ib,igrd)
230	dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
231	END DO
232	ENDIF
233
234	! tidal harmonic forcing ONLY: initialise arrays
235	IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d
236	IF( dta_alias%lneed_ssh ) dta_alias%ssh(:) = 0._wp
237	IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp
238	IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp
239	ENDIF
240
241	! If full velocities in boundary data, then split it into barotropic and baroclinic component
242	IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN ! if we read 3D total velocity (can be true only if u3d was read)
243	!
244	igrd = 2 ! zonal velocity
245	dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d
246	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
247	ii = idx_bdy(jbdy)%nbi(ib,igrd)
248	ij = idx_bdy(jbdy)%nbj(ib,igrd)
249	DO ik = 1, jpkm1
250	dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)
251	END DO
252	dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu_n(ii,ij)
253	DO ik = 1, jpkm1 ! compute barocline zonal velocity and put it in u3d
254	dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib)
255	END DO
256	END DO
257	igrd = 3 ! meridional velocity
258	dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d
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_alias%v2d(ib) = dta_alias%v2d(ib) + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)
264	END DO
265	dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv_n(ii,ij)
266	DO ik = 1, jpkm1 ! compute barocline meridional velocity and put it in v3d
267	dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib)
268	END DO
269	END DO
270	ENDIF ! ltotvel
271
272	! atm surface pressure : add inverted barometer effect to ssh if it was read
273	IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN
274	igrd = 1
275	DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is used only on the rim
276	ii = idx_bdy(jbdy)%nbi(ib,igrd)
277	ij = idx_bdy(jbdy)%nbj(ib,igrd)
278	dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij)
279	END DO
280	ENDIF
281
282	#if defined key_si3
283	IF( dta_alias%lneed_ice ) THEN
284	! fill temperature and salinity arrays
285	IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy)
286	IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_s)%fnow(:,1,:) = rice_tem (jbdy)
287	IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy)
288	IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy)
289	IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * & ! rice_apnd is the pond fraction
290	& bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd * a_i )
291	IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy)
292	! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2
293	IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) &
294	& bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdytsu)%fnow(:,1,:) + 271.15 )
295	! if T_su is read and not T_s, set T_s = T_su
296	IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) &
297	& bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:)
298	! if T_s is read and not T_su, set T_su = T_s
299	IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) &
300	& bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:)
301	! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2
302	IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) &
303	& bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdyt_s)%fnow(:,1,:) + 271.15 )
304
305	! make sure ponds = 0 if no ponds scheme
306	IF ( .NOT.ln_pnd ) THEN
307	bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp
308	bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp
309	ENDIF
310
311	! convert N-cat fields (input) into jpl-cat (output)
312	ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)
313	IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output)
314	CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), &
315	& dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , &
316	& bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), &
317	& bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), &
318	& bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), &
319	& dta_alias%t_i , dta_alias%t_s , &
320	& dta_alias%tsu , dta_alias%s_i , &
321	& dta_alias%aip , dta_alias%hip )
322	ENDIF
323	ENDIF
324	#endif
325	END DO ! jbdy
326
327	IF ( ln_tide ) THEN
328	IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data
329	DO jbdy = 1, nb_bdy ! Tidal component added in ts loop
330	IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN
331	nblen => idx_bdy(jbdy)%nblen
332	nblenrim => idx_bdy(jbdy)%nblenrim
333	IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:)
334	ELSE ; ilen1(:)=nblenrim(:)
335	ENDIF
336	IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
337	IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
338	IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
339	ENDIF
340	END DO
341	ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
342	!
343	CALL bdy_dta_tides( kt=kt, pt_offset=pt_offset )
344	ENDIF
345	ENDIF
346	!
347	IF( ln_timing ) CALL timing_stop('bdy_dta')
348	!
349	END SUBROUTINE bdy_dta
350
351
352	SUBROUTINE bdy_dta_init
353	!!----------------------------------------------------------------------
354	!! * SUBROUTINE bdy_dta_init *
355	!!
356	!! ** Purpose : Initialise arrays for reading of external data
357	!! for open boundary conditions
358	!!
359	!! ** Method :
360	!!
361	!!----------------------------------------------------------------------
362	INTEGER :: jbdy, jfld ! Local integers
363	INTEGER :: ierror, ios !
364	!
365	INTEGER :: nbdy_rdstart, nbdy_loc
366	CHARACTER(LEN=50) :: cerrmsg ! error string
367	CHARACTER(len=3) :: cl3 !
368	CHARACTER(len=100) :: cn_dir ! Root directory for location of data files
369	LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data
370	! ! =F => baroclinic velocities in 3D boundary data
371	LOGICAL :: ln_zinterp ! =T => requires a vertical interpolation of the bdydta
372	REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd
373	INTEGER :: ipk,ipl !
374	INTEGER :: idvar ! variable ID
375	INTEGER :: indims ! number of dimensions of the variable
376	INTEGER :: iszdim ! number of dimensions of the variable
377	INTEGER, DIMENSION(4) :: i4dimsz ! size of variable dimensions
378	INTEGER :: igrd ! index for grid type (1,2,3 = T,U,V)
379	LOGICAL :: lluld ! is the variable using the unlimited dimension
380	LOGICAL :: llneed !
381	LOGICAL :: llread !
382	TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill
383	TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read
384	TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip
385	TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill
386	TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias
387	!
388	NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d
389	NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip
390	NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd
391	NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp
392	!!---------------------------------------------------------------------------
393	!
394	IF(lwp) WRITE(numout,*)
395	IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
396	IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
397	IF(lwp) WRITE(numout,*) ''
398
399	ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror )
400	IF( ierror > 0 ) THEN
401	CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN
402	ENDIF
403	bf(:,:)%clrootname = 'NOT USED' ! default definition used as a flag in fld_read to do nothing.
404	bf(:,:)%lzint = .FALSE. ! default definition
405	bf(:,:)%ltotvel = .FALSE. ! default definition
406
407	! Read namelists
408	! --------------
409	nbdy_rdstart = 1
410	DO jbdy = 1, nb_bdy
411
412	WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy
413	WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy
414
415	! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we read from the beginning
416	READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
417	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' )
418
419	! by-pass nambdy_dta reading if no input data used in this bdy
420	IF( ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ) &
421	& .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND. nn_dyn3d_dta(jbdy) == 1 ) &
422	& .OR. ( dta_bdy(jbdy)%lneed_tra .AND. nn_tra_dta(jbdy) == 1 ) &
423	& .OR. ( dta_bdy(jbdy)%lneed_ice .AND. nn_ice_dta(jbdy) == 1 ) ) THEN
424	!
425	! Need to support possibility of reading more than one
426	! nambdy_dta from the namelist_cfg internal file.
427	! Do this by finding the jbdy'th occurence of nambdy_dta in the
428	! character buffer as the starting point.
429	!
430	nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_dta' )
431	IF( nbdy_loc .GT. 0 ) THEN
432	nbdy_rdstart = nbdy_rdstart + nbdy_loc
433	ELSE
434	WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',jbdy,' of nambdy_dta not found'
435	ios = -1
436	CALL ctl_nam ( ios , cerrmsg )
437	ENDIF
438	READ ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_dta, IOSTAT = ios, ERR = 902)
439	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' )
440	IF(lwm) WRITE( numond, nambdy_dta )
441	ENDIF
442
443	! get the number of ice categories in bdy data file (use a_i information to do this)
444	ipl = jpl ! default definition
445	IF( dta_bdy(jbdy)%lneed_ice ) THEN ! if we need ice bdy data
446	IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file
447	CALL fld_fill( bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 ) ! use namelist info
448	CALL fld_def( bf(jp_bdya_i,jbdy) )
449	CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num )
450	idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld )
451	IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl
452	ELSE ; ipl = 1 ! xy or xyt
453	ENDIF
454	CALL iom_close( bf(jp_bdya_i,jbdy)%num )
455	bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED' ! reset to default value as this subdomain may not need to read this bdy
456	ENDIF
457	ENDIF
458
459	#if defined key_si3
460	IF( .NOT.ln_pnd ) THEN
461	rn_ice_apnd = 0. ; rn_ice_hpnd = 0.
462	CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' )
463	ENDIF
464	#endif
465
466	! temp, salt, age and ponds of incoming ice
467	rice_tem (jbdy) = rn_ice_tem
468	rice_sal (jbdy) = rn_ice_sal
469	rice_age (jbdy) = rn_ice_age
470	rice_apnd(jbdy) = rn_ice_apnd
471	rice_hpnd(jbdy) = rn_ice_hpnd
472
473
474	DO jfld = 1, jpbdyfld
475
476	! =====================
477	! ssh
478	! =====================
479	IF( jfld == jp_bdyssh ) THEN
480	cl3 = 'ssh'
481	igrd = 1 ! T point
482	ipk = 1 ! surface data
483	llneed = dta_bdy(jbdy)%lneed_ssh ! dta_bdy(jbdy)%ssh will be needed
484	llread = MOD(nn_dyn2d_dta(jbdy),2) == 1 ! get data from NetCDF file
485	bf_alias => bf(jp_bdyssh,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy
486	bn_alias => bn_ssh ! alias for ssh structure of nambdy_dta
487	iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! length of this bdy on this MPI processus : used only on the rim
488	ENDIF
489	! =====================
490	! dyn2d
491	! =====================
492	IF( jfld == jp_bdyu2d ) THEN
493	cl3 = 'u2d'
494	igrd = 2 ! U point
495	ipk = 1 ! surface data
496	llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%ssh will be needed
497	llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file
498	bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy
499	bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta
500	IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from u3d -> need on the full bdy
501	ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim
502	ENDIF
503	ENDIF
504	IF( jfld == jp_bdyv2d ) THEN
505	cl3 = 'v2d'
506	igrd = 3 ! V point
507	ipk = 1 ! surface data
508	llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%ssh will be needed
509	llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file
510	bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy
511	bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta
512	IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from v3d -> need on the full bdy
513	ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim
514	ENDIF
515	ENDIF
516	! =====================
517	! dyn3d
518	! =====================
519	IF( jfld == jp_bdyu3d ) THEN
520	cl3 = 'u3d'
521	igrd = 2 ! U point
522	ipk = jpk ! 3d data
523	llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%u3d will be needed
524	& ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! u3d needed to compute u2d
525	llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file
526	bf_alias => bf(jp_bdyu3d,jbdy:jbdy) ! alias for u3d structure of bdy number jbdy
527	bn_alias => bn_u3d ! alias for u3d structure of nambdy_dta
528	iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus
529	ENDIF
530	IF( jfld == jp_bdyv3d ) THEN
531	cl3 = 'v3d'
532	igrd = 3 ! V point
533	ipk = jpk ! 3d data
534	llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%v3d will be needed
535	& ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! v3d needed to compute v2d
536	llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file
537	bf_alias => bf(jp_bdyv3d,jbdy:jbdy) ! alias for v3d structure of bdy number jbdy
538	bn_alias => bn_v3d ! alias for v3d structure of nambdy_dta
539	iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus
540	ENDIF
541
542	! =====================
543	! tra
544	! =====================
545	IF( jfld == jp_bdytem ) THEN
546	cl3 = 'tem'
547	igrd = 1 ! T point
548	ipk = jpk ! 3d data
549	llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%tem will be needed
550	llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file
551	bf_alias => bf(jp_bdytem,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy
552	bn_alias => bn_tem ! alias for ssh structure of nambdy_dta
553	iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus
554	ENDIF
555	IF( jfld == jp_bdysal ) THEN
556	cl3 = 'sal'
557	igrd = 1 ! T point
558	ipk = jpk ! 3d data
559	llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%sal will be needed
560	llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file
561	bf_alias => bf(jp_bdysal,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy
562	bn_alias => bn_sal ! alias for ssh structure of nambdy_dta
563	iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus
564	ENDIF
565
566	! =====================
567	! ice
568	! =====================
569	IF( jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. &
570	& jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. &
571	& jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip ) THEN
572	igrd = 1 ! T point
573	ipk = ipl ! jpl-cat data
574	llneed = dta_bdy(jbdy)%lneed_ice ! ice will be needed
575	llread = nn_ice_dta(jbdy) == 1 ! get data from NetCDF file
576	iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus
577	ENDIF
578	IF( jfld == jp_bdya_i ) THEN
579	cl3 = 'a_i'
580	bf_alias => bf(jp_bdya_i,jbdy:jbdy) ! alias for a_i structure of bdy number jbdy
581	bn_alias => bn_a_i ! alias for a_i structure of nambdy_dta
582	ENDIF
583	IF( jfld == jp_bdyh_i ) THEN
584	cl3 = 'h_i'
585	bf_alias => bf(jp_bdyh_i,jbdy:jbdy) ! alias for h_i structure of bdy number jbdy
586	bn_alias => bn_h_i ! alias for h_i structure of nambdy_dta
587	ENDIF
588	IF( jfld == jp_bdyh_s ) THEN
589	cl3 = 'h_s'
590	bf_alias => bf(jp_bdyh_s,jbdy:jbdy) ! alias for h_s structure of bdy number jbdy
591	bn_alias => bn_h_s ! alias for h_s structure of nambdy_dta
592	ENDIF
593	IF( jfld == jp_bdyt_i ) THEN
594	cl3 = 't_i'
595	bf_alias => bf(jp_bdyt_i,jbdy:jbdy) ! alias for t_i structure of bdy number jbdy
596	bn_alias => bn_t_i ! alias for t_i structure of nambdy_dta
597	ENDIF
598	IF( jfld == jp_bdyt_s ) THEN
599	cl3 = 't_s'
600	bf_alias => bf(jp_bdyt_s,jbdy:jbdy) ! alias for t_s structure of bdy number jbdy
601	bn_alias => bn_t_s ! alias for t_s structure of nambdy_dta
602	ENDIF
603	IF( jfld == jp_bdytsu ) THEN
604	cl3 = 'tsu'
605	bf_alias => bf(jp_bdytsu,jbdy:jbdy) ! alias for tsu structure of bdy number jbdy
606	bn_alias => bn_tsu ! alias for tsu structure of nambdy_dta
607	ENDIF
608	IF( jfld == jp_bdys_i ) THEN
609	cl3 = 's_i'
610	bf_alias => bf(jp_bdys_i,jbdy:jbdy) ! alias for s_i structure of bdy number jbdy
611	bn_alias => bn_s_i ! alias for s_i structure of nambdy_dta
612	ENDIF
613	IF( jfld == jp_bdyaip ) THEN
614	cl3 = 'aip'
615	bf_alias => bf(jp_bdyaip,jbdy:jbdy) ! alias for aip structure of bdy number jbdy
616	bn_alias => bn_aip ! alias for aip structure of nambdy_dta
617	ENDIF
618	IF( jfld == jp_bdyhip ) THEN
619	cl3 = 'hip'
620	bf_alias => bf(jp_bdyhip,jbdy:jbdy) ! alias for hip structure of bdy number jbdy
621	bn_alias => bn_hip ! alias for hip structure of nambdy_dta
622	ENDIF
623
624	IF( llneed .AND. iszdim > 0 ) THEN ! dta_bdy(jbdy)%xxx will be needed
625	! ! -> must be associated with an allocated target
626	ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) ) ! allocate the target
627	!
628	IF( llread ) THEN ! get data from NetCDF file
629	CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 ) ! use namelist info
630	IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) )
631	bf_alias(1)%imap => idx_bdy(jbdy)%nbmap(1:iszdim,igrd) ! associate the mapping used for this bdy
632	bf_alias(1)%igrd = igrd ! used only for vertical integration of 3D arrays
633	bf_alias(1)%ibdy = jbdy ! " " " " " " " "
634	bf_alias(1)%ltotvel = ln_full_vel ! T if u3d is full velocity
635	bf_alias(1)%lzint = ln_zinterp ! T if it requires a vertical interpolation
636	ENDIF
637
638	! associate the pointer and get rid of the dimensions with a size equal to 1
639	IF( jfld == jp_bdyssh ) dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1)
640	IF( jfld == jp_bdyu2d ) dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1)
641	IF( jfld == jp_bdyv2d ) dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1)
642	IF( jfld == jp_bdyu3d ) dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:)
643	IF( jfld == jp_bdyv3d ) dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:)
644	IF( jfld == jp_bdytem ) dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:)
645	IF( jfld == jp_bdysal ) dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:)
646	IF( jfld == jp_bdya_i ) THEN
647	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:)
648	ELSE ; ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) )
649	ENDIF
650	ENDIF
651	IF( jfld == jp_bdyh_i ) THEN
652	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:)
653	ELSE ; ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) )
654	ENDIF
655	ENDIF
656	IF( jfld == jp_bdyh_s ) THEN
657	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:)
658	ELSE ; ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) )
659	ENDIF
660	ENDIF
661	IF( jfld == jp_bdyt_i ) THEN
662	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_i => bf_alias(1)%fnow(:,1,:)
663	ELSE ; ALLOCATE( dta_bdy(jbdy)%t_i(iszdim,jpl) )
664	ENDIF
665	ENDIF
666	IF( jfld == jp_bdyt_s ) THEN
667	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_s => bf_alias(1)%fnow(:,1,:)
668	ELSE ; ALLOCATE( dta_bdy(jbdy)%t_s(iszdim,jpl) )
669	ENDIF
670	ENDIF
671	IF( jfld == jp_bdytsu ) THEN
672	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%tsu => bf_alias(1)%fnow(:,1,:)
673	ELSE ; ALLOCATE( dta_bdy(jbdy)%tsu(iszdim,jpl) )
674	ENDIF
675	ENDIF
676	IF( jfld == jp_bdys_i ) THEN
677	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%s_i => bf_alias(1)%fnow(:,1,:)
678	ELSE ; ALLOCATE( dta_bdy(jbdy)%s_i(iszdim,jpl) )
679	ENDIF
680	ENDIF
681	IF( jfld == jp_bdyaip ) THEN
682	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%aip => bf_alias(1)%fnow(:,1,:)
683	ELSE ; ALLOCATE( dta_bdy(jbdy)%aip(iszdim,jpl) )
684	ENDIF
685	ENDIF
686	IF( jfld == jp_bdyhip ) THEN
687	IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hip => bf_alias(1)%fnow(:,1,:)
688	ELSE ; ALLOCATE( dta_bdy(jbdy)%hip(iszdim,jpl) )
689	ENDIF
690	ENDIF
691	ENDIF
692
693	END DO ! jpbdyfld
694	!
695	END DO ! jbdy
696	!
697	END SUBROUTINE bdy_dta_init
698
699	!!==============================================================================
700	END MODULE bdydta

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

Download in other formats: