Context Navigation

bdydta.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 5 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

File size: 39.8 KB

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/trunk/src/OCE/BDY/bdydta.F90 @ 12377

Download in other formats: