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

Context Navigation

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

Last change on this file since 10455 was 10068, checked in by nicolasmartin, 6 years ago
First part of modifications to have a common default header : fix typos and SVN keywords properties
Property svn:keywords set to `Id`
File size: 37.8 KB

Rev	Line
[911]	1	MODULE bdydta
[1125]	2	!!======================================================================
	3	!! * MODULE bdydta *
[911]	4	!! Open boundary data : read the data for the unstructured open boundaries.
[1125]	5	!!======================================================================
	6	!! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code
	7	!! - ! 2007-01 (D. Storkey) Update to use IOM module
[2528]	8	!! - ! 2007-07 (D. Storkey) add bdy_dta_fla
[1125]	9	!! 3.0 ! 2008-04 (NEMO team) add in the reference version
[2528]	10	!! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations
	11	!! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions
[3294]	12	!! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge
[9656]	13	!! 3.6 ! 2012-01 (C. Rousset) add ice boundary conditions for sea ice
	14	!! 4.0 ! 2018 (C. Rousset) SI3 compatibility
[1125]	15	!!----------------------------------------------------------------------
[9019]	16
[1125]	17	!!----------------------------------------------------------------------
[9019]	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 sbctide ! Tidal forcing or not
	26	USE bdy_oce ! ocean open boundary conditions
	27	USE bdytides ! tidal forcing at boundaries
[9570]	28	#if defined key_si3
[9019]	29	USE ice ! sea-ice variables
	30	USE icevar ! redistribute ice input into categories
[2528]	31	#endif
[9019]	32	!
	33	USE fldread ! read input fields
	34	USE iom ! IOM library
	35	USE in_out_manager ! I/O logical units
	36	USE timing ! Timing
[911]	37
	38	IMPLICIT NONE
	39	PRIVATE
	40
[3294]	41	PUBLIC bdy_dta ! routine called by step.F90 and dynspg_ts.F90
	42	PUBLIC bdy_dta_init ! routine called by nemogcm.F90
[911]	43
[3294]	44	INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_bdy_fld ! Number of fields to update for each boundary set.
	45	INTEGER :: nb_bdy_fld_sum ! Total number of fields to update for all boundary sets.
	46	LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions
	47	! =F => baroclinic velocities in 3D boundary conditions
[4354]	48	!$AGRIF_DO_NOT_TREAT
[3294]	49	TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: bf ! structure of input fields (file informations, fields read)
[4354]	50	!$AGRIF_END_DO_NOT_TREAT
[3294]	51	TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap
[911]	52
[9570]	53	#if defined key_si3
[9019]	54	INTEGER :: nice_cat ! number of categories in the input file
	55	INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure
[9810]	56	INTEGER, DIMENSION(jp_bdy) :: jfld_htit, jfld_htst, jfld_ait
[4292]	57	#endif
	58
[1125]	59	!!----------------------------------------------------------------------
[9598]	60	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1146]	61	!! $Id$
[10068]	62	!! Software governed by the CeCILL license (see ./LICENSE)
[1125]	63	!!----------------------------------------------------------------------
[911]	64	CONTAINS
	65
[3294]	66	SUBROUTINE bdy_dta( kt, jit, time_offset )
[1125]	67	!!----------------------------------------------------------------------
[3294]	68	!! * SUBROUTINE bdy_dta *
[911]	69	!!
[3294]	70	!! ** Purpose : Update external data for open boundary conditions
[911]	71	!!
[3294]	72	!! ** Method : Use fldread.F90
	73	!!
[1125]	74	!!----------------------------------------------------------------------
[6140]	75	INTEGER, INTENT(in) :: kt ! ocean time-step index
	76	INTEGER, INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)
	77	INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit
	78	! ! is present then units = subcycle timesteps.
	79	! ! time_offset = 0 => get data at "now" time level
	80	! ! time_offset = -1 => get data at "before" time level
	81	! ! time_offset = +1 => get data at "after" time level
	82	! ! etc.
	83	!
[9019]	84	INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices
	85	INTEGER :: ii, ij, ik, igrd ! local integers
[3294]	86	INTEGER, DIMENSION(jpbgrd) :: ilen1
	87	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
[4292]	88	TYPE(OBC_DATA), POINTER :: dta ! short cut
[911]	89	!!---------------------------------------------------------------------------
[6140]	90	!
[9124]	91	IF( ln_timing ) CALL timing_start('bdy_dta')
[6140]	92	!
[3294]	93	! Initialise data arrays once for all from initial conditions where required
	94	!---------------------------------------------------------------------------
[6140]	95	IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN
[1125]	96
[3294]	97	! Calculate depth-mean currents
	98	!-----------------------------
	99
[9019]	100	DO jbdy = 1, nb_bdy
[6140]	101	!
[9019]	102	nblen => idx_bdy(jbdy)%nblen
	103	nblenrim => idx_bdy(jbdy)%nblenrim
	104	dta => dta_bdy(jbdy)
	105	!
	106	IF( nn_dyn2d_dta(jbdy) == 0 ) THEN
[3651]	107	ilen1(:) = nblen(:)
[4292]	108	IF( dta%ll_ssh ) THEN
	109	igrd = 1
	110	DO ib = 1, ilen1(igrd)
[9019]	111	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	112	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	113	dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)
[4292]	114	END DO
[9019]	115	ENDIF
[4292]	116	IF( dta%ll_u2d ) THEN
	117	igrd = 2
	118	DO ib = 1, ilen1(igrd)
[9019]	119	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	120	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	121	dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)
[4292]	122	END DO
[9019]	123	ENDIF
[4292]	124	IF( dta%ll_v2d ) THEN
	125	igrd = 3
	126	DO ib = 1, ilen1(igrd)
[9019]	127	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	128	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	129	dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)
[4292]	130	END DO
[9019]	131	ENDIF
[4292]	132	ENDIF
[9019]	133	!
	134	IF( nn_dyn3d_dta(jbdy) == 0 ) THEN
[4292]	135	ilen1(:) = nblen(:)
	136	IF( dta%ll_u3d ) THEN
	137	igrd = 2
	138	DO ib = 1, ilen1(igrd)
	139	DO ik = 1, jpkm1
[9019]	140	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	141	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	142	dta_bdy(jbdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)
[3294]	143	END DO
[4292]	144	END DO
[9019]	145	ENDIF
[4292]	146	IF( dta%ll_v3d ) THEN
	147	igrd = 3
	148	DO ib = 1, ilen1(igrd)
	149	DO ik = 1, jpkm1
[9019]	150	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	151	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	152	dta_bdy(jbdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)
[4292]	153	END DO
	154	END DO
[9019]	155	ENDIF
[3294]	156	ENDIF
[911]	157
[9019]	158	IF( nn_tra_dta(jbdy) == 0 ) THEN
[3651]	159	ilen1(:) = nblen(:)
[4292]	160	IF( dta%ll_tem ) THEN
	161	igrd = 1
	162	DO ib = 1, ilen1(igrd)
	163	DO ik = 1, jpkm1
[9019]	164	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	165	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	166	dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)
[4292]	167	END DO
	168	END DO
[9019]	169	ENDIF
[4292]	170	IF( dta%ll_sal ) THEN
	171	igrd = 1
	172	DO ib = 1, ilen1(igrd)
	173	DO ik = 1, jpkm1
[9019]	174	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	175	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	176	dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)
[4292]	177	END DO
	178	END DO
[9019]	179	ENDIF
[3294]	180	ENDIF
[911]	181
[9570]	182	#if defined key_si3
[9657]	183	IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values
[3651]	184	ilen1(:) = nblen(:)
[4292]	185	IF( dta%ll_a_i ) THEN
	186	igrd = 1
	187	DO jl = 1, jpl
	188	DO ib = 1, ilen1(igrd)
[9019]	189	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	190	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	191	dta_bdy(jbdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1)
[4292]	192	END DO
	193	END DO
	194	ENDIF
[9019]	195	IF( dta%ll_h_i ) THEN
[4292]	196	igrd = 1
	197	DO jl = 1, jpl
	198	DO ib = 1, ilen1(igrd)
[9019]	199	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	200	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	201	dta_bdy(jbdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1)
[4292]	202	END DO
	203	END DO
	204	ENDIF
[9019]	205	IF( dta%ll_h_s ) THEN
[4292]	206	igrd = 1
	207	DO jl = 1, jpl
	208	DO ib = 1, ilen1(igrd)
[9019]	209	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	210	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	211	dta_bdy(jbdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1)
[4292]	212	END DO
	213	END DO
	214	ENDIF
	215	ENDIF
[3294]	216	#endif
[9019]	217	END DO ! jbdy
[6140]	218	!
	219	ENDIF ! kt == nit000
[911]	220
[3294]	221	! update external data from files
	222	!--------------------------------
	223
	224	jstart = 1
[9019]	225	DO jbdy = 1, nb_bdy
	226	dta => dta_bdy(jbdy)
	227	IF( nn_dta(jbdy) == 1 ) THEN ! skip this bit if no external data required
[3294]	228
	229	IF( PRESENT(jit) ) THEN
	230	! Update barotropic boundary conditions only
[3651]	231	! jit is optional argument for fld_read and bdytide_update
[9019]	232	IF( cn_dyn2d(jbdy) /= 'none' ) THEN
	233	IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
[6140]	234	IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
	235	IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
	236	IF( dta%ll_u3d ) dta%v2d(:) = 0._wp
[3294]	237	ENDIF
[9019]	238	IF (cn_tra(jbdy) /= 'runoff') THEN
	239	IF( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) THEN
[3703]	240
[4292]	241	jend = jstart + dta%nread(2) - 1
[9019]	242	IF( ln_full_vel_array(jbdy) ) THEN
[7646]	243	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), &
[8329]	244	& kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, &
[9019]	245	& fvl=ln_full_vel_array(jbdy) )
[7646]	246	ELSE
	247	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), &
	248	& kit=jit, kt_offset=time_offset )
	249	ENDIF
[3703]	250
[4292]	251	! If full velocities in boundary data then extract barotropic velocities from 3D fields
[9019]	252	IF( ln_full_vel_array(jbdy) .AND. &
	253	& ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. &
	254	& nn_dyn3d_dta(jbdy) == 1 ) )THEN
[3703]	255
[3651]	256	igrd = 2 ! zonal velocity
[6140]	257	dta%u2d(:) = 0._wp
[9019]	258	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
	259	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	260	ij = idx_bdy(jbdy)%nbj(ib,igrd)
[3651]	261	DO ik = 1, jpkm1
[4292]	262	dta%u2d(ib) = dta%u2d(ib) &
[6140]	263	& + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
[3651]	264	END DO
[6140]	265	dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij)
[3651]	266	END DO
	267	igrd = 3 ! meridional velocity
[6140]	268	dta%v2d(:) = 0._wp
[9019]	269	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
	270	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	271	ij = idx_bdy(jbdy)%nbj(ib,igrd)
[3651]	272	DO ik = 1, jpkm1
[4292]	273	dta%v2d(ib) = dta%v2d(ib) &
[6140]	274	& + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
[3651]	275	END DO
[6140]	276	dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij)
[3651]	277	END DO
	278	ENDIF
	279	ENDIF
[9019]	280	IF( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN ! update tidal harmonic forcing
	281	CALL bdytide_update( kt=kt, idx=idx_bdy(jbdy), dta=dta, td=tides(jbdy), &
[3651]	282	& jit=jit, time_offset=time_offset )
	283	ENDIF
[3294]	284	ENDIF
[1125]	285	ENDIF
[3294]	286	ELSE
[9019]	287	IF (cn_tra(jbdy) == 'runoff') then ! runoff condition
	288	jend = nb_bdy_fld(jbdy)
[3703]	289	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
[3851]	290	& map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
[3651]	291	!
	292	igrd = 2 ! zonal velocity
[9019]	293	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
	294	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	295	ij = idx_bdy(jbdy)%nbj(ib,igrd)
[4292]	296	dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
[3651]	297	END DO
	298	!
	299	igrd = 3 ! meridional velocity
[9019]	300	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
	301	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	302	ij = idx_bdy(jbdy)%nbj(ib,igrd)
[4292]	303	dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
[3651]	304	END DO
	305	ELSE
[9019]	306	IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
[6140]	307	IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
	308	IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
	309	IF( dta%ll_v2d ) dta%v2d(:) = 0._wp
[3651]	310	ENDIF
[4292]	311	IF( dta%nread(1) .gt. 0 ) THEN ! update external data
	312	jend = jstart + dta%nread(1) - 1
[3703]	313	CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
[8329]	314	& map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, &
[9019]	315	& fvl=ln_full_vel_array(jbdy) )
[3651]	316	ENDIF
	317	! If full velocities in boundary data then split into barotropic and baroclinic data
[9019]	318	IF( ln_full_vel_array(jbdy) .and. &
	319	& ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. &
	320	& nn_dyn3d_dta(jbdy) == 1 ) ) THEN
[3651]	321	igrd = 2 ! zonal velocity
[6140]	322	dta%u2d(:) = 0._wp
[9019]	323	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
	324	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	325	ij = idx_bdy(jbdy)%nbj(ib,igrd)
[3651]	326	DO ik = 1, jpkm1
[4292]	327	dta%u2d(ib) = dta%u2d(ib) &
[6140]	328	& + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
[3651]	329	END DO
[6140]	330	dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij)
[3651]	331	DO ik = 1, jpkm1
[4292]	332	dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib)
[3651]	333	END DO
	334	END DO
	335	igrd = 3 ! meridional velocity
[6140]	336	dta%v2d(:) = 0._wp
[9019]	337	DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
	338	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	339	ij = idx_bdy(jbdy)%nbj(ib,igrd)
[3651]	340	DO ik = 1, jpkm1
[4292]	341	dta%v2d(ib) = dta%v2d(ib) &
[6140]	342	& + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
[3651]	343	END DO
[6140]	344	dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij)
[3651]	345	DO ik = 1, jpkm1
[4292]	346	dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib)
[3651]	347	END DO
	348	END DO
	349	ENDIF
[4292]	350
[1125]	351	ENDIF
[9570]	352	#if defined key_si3
[9905]	353	! convert N-cat fields (input) into jpl-cat (output)
[9657]	354	IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN
[9810]	355	jfld_hti = jfld_htit(jbdy)
	356	jfld_hts = jfld_htst(jbdy)
	357	jfld_ai = jfld_ait(jbdy)
[9905]	358	IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1
[9019]	359	CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
	360	& dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )
[9905]	361	ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl
[9019]	362	CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), &
	363	& dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )
	364	ENDIF
[4292]	365	ENDIF
	366	#endif
[1125]	367	ENDIF
[4292]	368	jstart = jstart + dta%nread(1)
[9019]	369	ENDIF ! nn_dta(jbdy) = 1
	370	END DO ! jbdy
[911]	371
[7646]	372	IF ( ln_tide ) THEN
	373	IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data
[9019]	374	DO jbdy = 1, nb_bdy ! Tidal component added in ts loop
	375	IF ( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN
	376	nblen => idx_bdy(jbdy)%nblen
	377	nblenrim => idx_bdy(jbdy)%nblenrim
	378	IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF
	379	IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
	380	IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
	381	IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
[7646]	382	ENDIF
	383	END DO
	384	ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
	385	!
	386	CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
	387	ENDIF
[5930]	388	ENDIF
[4292]	389
[3651]	390	IF ( ln_apr_obc ) THEN
[9019]	391	DO jbdy = 1, nb_bdy
	392	IF (cn_tra(jbdy) /= 'runoff')THEN
[3651]	393	igrd = 1 ! meridional velocity
[9019]	394	DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)
	395	ii = idx_bdy(jbdy)%nbi(ib,igrd)
	396	ij = idx_bdy(jbdy)%nbj(ib,igrd)
	397	dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij)
[6140]	398	END DO
[1125]	399	ENDIF
[6140]	400	END DO
[3651]	401	ENDIF
[6140]	402	!
[9124]	403	IF( ln_timing ) CALL timing_stop('bdy_dta')
[6140]	404	!
	405	END SUBROUTINE bdy_dta
[911]	406
	407
[6140]	408	SUBROUTINE bdy_dta_init
[3294]	409	!!----------------------------------------------------------------------
	410	!! * SUBROUTINE bdy_dta_init *
	411	!!
	412	!! ** Purpose : Initialise arrays for reading of external data
	413	!! for open boundary conditions
	414	!!
[4292]	415	!! ** Method :
[3294]	416	!!
	417	!!----------------------------------------------------------------------
[9019]	418	INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers
[6140]	419	!
[3294]	420	CHARACTER(len=100) :: cn_dir ! Root directory for location of data files
	421	CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files
[5919]	422	CHARACTER(len = 256):: clname ! temporary file name
[3294]	423	LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data
[9019]	424	! ! =F => baroclinic velocities in 3D boundary data
[3294]	425	INTEGER :: ilen_global ! Max length required for global bdy dta arrays
	426	INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays
	427	INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld
	428	INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V)
	429	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
[4292]	430	TYPE(OBC_DATA), POINTER :: dta ! short cut
[9570]	431	#if defined key_si3
[9019]	432	INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)
	433	INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions
[4292]	434	INTEGER :: inum,id1 ! local integer
	435	#endif
[3294]	436	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures
	437	TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d !
	438	TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read
[9570]	439	#if defined key_si3
[9019]	440	TYPE(FLD_N) :: bn_a_i, bn_h_i, bn_h_s
[2528]	441	#endif
[3294]	442	NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d
[9570]	443	#if defined key_si3
[9019]	444	NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s
[3294]	445	#endif
[7646]	446	NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy
[3294]	447	!!---------------------------------------------------------------------------
[6140]	448	!
[3651]	449	IF(lwp) WRITE(numout,*)
	450	IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
	451	IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
	452	IF(lwp) WRITE(numout,*) ''
	453
[3294]	454	! Set nn_dta
[9019]	455	DO jbdy = 1, nb_bdy
	456	nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) &
	457	& , nn_dyn3d_dta (jbdy) &
	458	& , nn_tra_dta (jbdy) &
[9570]	459	#if defined key_si3
[9657]	460	& , nn_ice_dta (jbdy) &
[2528]	461	#endif
[3294]	462	)
[9019]	463	IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1
[3294]	464	END DO
[911]	465
[3294]	466	! Work out upper bound of how many fields there are to read in and allocate arrays
	467	! ---------------------------------------------------------------------------
	468	ALLOCATE( nb_bdy_fld(nb_bdy) )
	469	nb_bdy_fld(:) = 0
[9019]	470	DO jbdy = 1, nb_bdy
	471	IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN
	472	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3
[3294]	473	ENDIF
[9019]	474	IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN
	475	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2
[3294]	476	ENDIF
[9019]	477	IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN
	478	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2
[3294]	479	ENDIF
[9570]	480	#if defined key_si3
[9657]	481	IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN
[9019]	482	nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3
[3294]	483	ENDIF
	484	#endif
[9019]	485	IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy)
[6140]	486	END DO
[2528]	487
[3294]	488	nb_bdy_fld_sum = SUM( nb_bdy_fld )
[911]	489
[3294]	490	ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
	491	IF( ierror > 0 ) THEN
	492	CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN
[911]	493	ENDIF
[3294]	494	ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
	495	IF( ierror > 0 ) THEN
	496	CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN
[1125]	497	ENDIF
[3294]	498	ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
	499	IF( ierror > 0 ) THEN
	500	CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN
	501	ENDIF
	502	ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )
	503	ALLOCATE( ibdy(nb_bdy_fld_sum) )
	504	ALLOCATE( igrid(nb_bdy_fld_sum) )
[911]	505
[3294]	506	! Read namelists
	507	! --------------
[4147]	508	REWIND(numnam_ref)
	509	REWIND(numnam_cfg)
[3294]	510	jfld = 0
[9019]	511	DO jbdy = 1, nb_bdy
	512	IF( nn_dta(jbdy) == 1 ) THEN
[4147]	513	READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
[6140]	514	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
[4147]	515	READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
[9168]	516	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
[6140]	517	IF(lwm) WRITE( numond, nambdy_dta )
[4147]	518
[9019]	519	cn_dir_array(jbdy) = cn_dir
	520	ln_full_vel_array(jbdy) = ln_full_vel
[911]	521
[9019]	522	nblen => idx_bdy(jbdy)%nblen
	523	nblenrim => idx_bdy(jbdy)%nblenrim
	524	dta => dta_bdy(jbdy)
[4292]	525	dta%nread(2) = 0
[911]	526
[3294]	527	! Only read in necessary fields for this set.
	528	! Important that barotropic variables come first.
[9019]	529	IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN
[911]	530
[4292]	531	IF( dta%ll_ssh ) THEN
	532	if(lwp) write(numout,*) '++++++ reading in ssh field'
[3294]	533	jfld = jfld + 1
	534	blf_i(jfld) = bn_ssh
[9019]	535	ibdy(jfld) = jbdy
[3294]	536	igrid(jfld) = 1
[3651]	537	ilen1(jfld) = nblen(igrid(jfld))
[3294]	538	ilen3(jfld) = 1
[4292]	539	dta%nread(2) = dta%nread(2) + 1
[3294]	540	ENDIF
[911]	541
[9019]	542	IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN
[4292]	543	if(lwp) write(numout,*) '++++++ reading in u2d field'
[3294]	544	jfld = jfld + 1
	545	blf_i(jfld) = bn_u2d
[9019]	546	ibdy(jfld) = jbdy
[3294]	547	igrid(jfld) = 2
[3651]	548	ilen1(jfld) = nblen(igrid(jfld))
[3294]	549	ilen3(jfld) = 1
[4292]	550	dta%nread(2) = dta%nread(2) + 1
	551	ENDIF
[911]	552
[9019]	553	IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN
[4292]	554	if(lwp) write(numout,*) '++++++ reading in v2d field'
[3294]	555	jfld = jfld + 1
	556	blf_i(jfld) = bn_v2d
[9019]	557	ibdy(jfld) = jbdy
[3294]	558	igrid(jfld) = 3
[3651]	559	ilen1(jfld) = nblen(igrid(jfld))
[3294]	560	ilen3(jfld) = 1
[4292]	561	dta%nread(2) = dta%nread(2) + 1
[3294]	562	ENDIF
[911]	563
[3294]	564	ENDIF
[1125]	565
[4292]	566	! read 3D velocities if baroclinic velocities require OR if
	567	! barotropic velocities required and ln_full_vel set to .true.
[9019]	568	IF( nn_dyn3d_dta(jbdy) == 1 .OR. &
	569	& ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN
[911]	570
[9019]	571	IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN
[4292]	572	if(lwp) write(numout,*) '++++++ reading in u3d field'
	573	jfld = jfld + 1
	574	blf_i(jfld) = bn_u3d
[9019]	575	ibdy(jfld) = jbdy
[4292]	576	igrid(jfld) = 2
	577	ilen1(jfld) = nblen(igrid(jfld))
	578	ilen3(jfld) = jpk
[9019]	579	IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1
[4292]	580	ENDIF
[911]	581
[9019]	582	IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN
[4292]	583	if(lwp) write(numout,*) '++++++ reading in v3d field'
	584	jfld = jfld + 1
	585	blf_i(jfld) = bn_v3d
[9019]	586	ibdy(jfld) = jbdy
[4292]	587	igrid(jfld) = 3
	588	ilen1(jfld) = nblen(igrid(jfld))
	589	ilen3(jfld) = jpk
[9019]	590	IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1
[4292]	591	ENDIF
[911]	592
[3294]	593	ENDIF
[911]	594
[3294]	595	! temperature and salinity
[9019]	596	IF( nn_tra_dta(jbdy) == 1 ) THEN
[911]	597
[4292]	598	IF( dta%ll_tem ) THEN
	599	if(lwp) write(numout,*) '++++++ reading in tem field'
	600	jfld = jfld + 1
	601	blf_i(jfld) = bn_tem
[9019]	602	ibdy(jfld) = jbdy
[4292]	603	igrid(jfld) = 1
	604	ilen1(jfld) = nblen(igrid(jfld))
	605	ilen3(jfld) = jpk
	606	ENDIF
[911]	607
[4292]	608	IF( dta%ll_sal ) THEN
	609	if(lwp) write(numout,*) '++++++ reading in sal field'
	610	jfld = jfld + 1
	611	blf_i(jfld) = bn_sal
[9019]	612	ibdy(jfld) = jbdy
[4292]	613	igrid(jfld) = 1
	614	ilen1(jfld) = nblen(igrid(jfld))
	615	ilen3(jfld) = jpk
	616	ENDIF
[911]	617
	618	ENDIF
	619
[9570]	620	#if defined key_si3
[3294]	621	! sea ice
[9657]	622	IF( nn_ice_dta(jbdy) == 1 ) THEN
[9019]	623	! Test for types of ice input (1cat or Xcat)
[5919]	624	! Build file name to find dimensions
[7861]	625	clname=TRIM( cn_dir )//TRIM(bn_a_i%clname)
[5919]	626	IF( .NOT. bn_a_i%ln_clim ) THEN
[7861]	627	WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear ! add year
	628	IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month
[5919]	629	ELSE
[7861]	630	IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth ! add month
[5919]	631	ENDIF
	632	IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) &
[7861]	633	& WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day
[5919]	634	!
	635	CALL iom_open ( clname, inum )
[9019]	636	id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. )
[5919]	637	CALL iom_close ( inum )
[4292]	638
[9019]	639	IF ( kndims == 4 ) THEN
	640	nice_cat = kdimsz(4) ! Xcat input
[4292]	641	ELSE
[9019]	642	nice_cat = 1 ! 1cat input
[4292]	643	ENDIF
	644	! End test
	645
	646	IF( dta%ll_a_i ) THEN
	647	jfld = jfld + 1
	648	blf_i(jfld) = bn_a_i
[9019]	649	ibdy(jfld) = jbdy
[4292]	650	igrid(jfld) = 1
	651	ilen1(jfld) = nblen(igrid(jfld))
[9019]	652	ilen3(jfld) = nice_cat
[4292]	653	ENDIF
	654
[9019]	655	IF( dta%ll_h_i ) THEN
[4292]	656	jfld = jfld + 1
[9019]	657	blf_i(jfld) = bn_h_i
	658	ibdy(jfld) = jbdy
[4292]	659	igrid(jfld) = 1
	660	ilen1(jfld) = nblen(igrid(jfld))
[9019]	661	ilen3(jfld) = nice_cat
[4292]	662	ENDIF
	663
[9019]	664	IF( dta%ll_h_s ) THEN
[4292]	665	jfld = jfld + 1
[9019]	666	blf_i(jfld) = bn_h_s
	667	ibdy(jfld) = jbdy
[4292]	668	igrid(jfld) = 1
	669	ilen1(jfld) = nblen(igrid(jfld))
[9019]	670	ilen3(jfld) = nice_cat
[4292]	671	ENDIF
	672
[4333]	673	ENDIF
[3294]	674	#endif
	675	! Recalculate field counts
	676	!-------------------------
[9019]	677	IF( jbdy == 1 ) THEN
[4148]	678	nb_bdy_fld_sum = 0
[9019]	679	nb_bdy_fld(jbdy) = jfld
[3294]	680	nb_bdy_fld_sum = jfld
	681	ELSE
[9019]	682	nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum
	683	nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy)
[3294]	684	ENDIF
[911]	685
[9019]	686	dta%nread(1) = nb_bdy_fld(jbdy)
[4292]	687
[6140]	688	ENDIF ! nn_dta == 1
[9019]	689	ENDDO ! jbdy
[911]	690
[3294]	691	DO jfld = 1, nb_bdy_fld_sum
	692	ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
	693	IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
	694	nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
[5132]	695	nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld))
[3294]	696	ENDDO
[911]	697
[3294]	698	! fill bf with blf_i and control print
	699	!-------------------------------------
	700	jstart = 1
[9019]	701	DO jbdy = 1, nb_bdy
	702	jend = jstart - 1 + nb_bdy_fld(jbdy)
	703	CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', &
[3294]	704	& 'open boundary conditions', 'nambdy_dta' )
	705	jstart = jend + 1
	706	ENDDO
[911]	707
[9629]	708	DO jfld = 1, nb_bdy_fld_sum
	709	bf(jfld)%igrd = igrid(jfld)
	710	bf(jfld)%ibdy = ibdy(jfld)
	711	ENDDO
	712
[3294]	713	! Initialise local boundary data arrays
	714	! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
	715	! nn_xxx_dta=1 : point to "fnow" arrays
	716	!-------------------------------------
[911]	717
[3294]	718	jfld = 0
[9019]	719	DO jbdy=1, nb_bdy
[911]	720
[9019]	721	nblen => idx_bdy(jbdy)%nblen
	722	dta => dta_bdy(jbdy)
[911]	723
[4292]	724	if(lwp) then
	725	write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh
	726	write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d
	727	write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d
	728	write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d
	729	write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d
	730	write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem
	731	write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal
	732	endif
	733
[9019]	734	IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN
[4292]	735	if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space'
	736	IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) )
	737	IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) )
	738	IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
	739	ENDIF
[9019]	740	IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN
[4292]	741	IF( dta%ll_ssh ) THEN
	742	if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
	743	jfld = jfld + 1
	744	dta%ssh => bf(jfld)%fnow(:,1,1)
	745	ENDIF
	746	IF ( dta%ll_u2d ) THEN
[9019]	747	IF ( ln_full_vel_array(jbdy) ) THEN
[4292]	748	if(lwp) write(numout,*) '++++++ dta%u2d allocated space'
	749	ALLOCATE( dta%u2d(nblen(2)) )
	750	ELSE
	751	if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow'
[3651]	752	jfld = jfld + 1
[4292]	753	dta%u2d => bf(jfld)%fnow(:,1,1)
	754	ENDIF
	755	ENDIF
	756	IF ( dta%ll_v2d ) THEN
[9019]	757	IF ( ln_full_vel_array(jbdy) ) THEN
[4292]	758	if(lwp) write(numout,*) '++++++ dta%v2d allocated space'
	759	ALLOCATE( dta%v2d(nblen(3)) )
[3294]	760	ELSE
[4292]	761	if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow'
[3294]	762	jfld = jfld + 1
[4292]	763	dta%v2d => bf(jfld)%fnow(:,1,1)
[3294]	764	ENDIF
	765	ENDIF
	766	ENDIF
[911]	767
[9019]	768	IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN
[4292]	769	if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space'
[9019]	770	IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) )
	771	IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) )
[3294]	772	ENDIF
[9019]	773	IF ( nn_dyn3d_dta(jbdy) == 1 .or. &
	774	& ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN
	775	IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN
[4292]	776	if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow'
	777	jfld = jfld + 1
[9019]	778	dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:)
[4292]	779	ENDIF
[9019]	780	IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN
[4292]	781	if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow'
	782	jfld = jfld + 1
[9019]	783	dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:)
[4292]	784	ENDIF
[3294]	785	ENDIF
[911]	786
[9019]	787	IF( nn_tra_dta(jbdy) == 0 ) THEN
[4292]	788	if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space'
[9019]	789	IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) )
	790	IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) )
[4292]	791	ELSE
	792	IF( dta%ll_tem ) THEN
	793	if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow'
[3294]	794	jfld = jfld + 1
[9019]	795	dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:)
[4292]	796	ENDIF
	797	IF( dta%ll_sal ) THEN
	798	if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow'
[3294]	799	jfld = jfld + 1
[9019]	800	dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:)
[3294]	801	ENDIF
	802	ENDIF
[911]	803
[9570]	804	#if defined key_si3
[9657]	805	IF (cn_ice(jbdy) /= 'none') THEN
	806	IF( nn_ice_dta(jbdy) == 0 ) THEN
[9019]	807	ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) )
	808	ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) )
	809	ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) )
[3294]	810	ELSE
[9019]	811	IF ( nice_cat == jpl ) THEN ! case input cat = jpl
[4292]	812	jfld = jfld + 1
[9019]	813	dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:)
[4292]	814	jfld = jfld + 1
[9019]	815	dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:)
[4292]	816	jfld = jfld + 1
[9019]	817	dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:)
	818	ELSE ! case input cat = 1 OR (/=1 and /=jpl)
[9810]	819	jfld_ait(jbdy) = jfld + 1
	820	jfld_htit(jbdy) = jfld + 2
	821	jfld_htst(jbdy) = jfld + 3
[4292]	822	jfld = jfld + 3
[9019]	823	ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) )
	824	ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) )
	825	ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) )
	826	dta_bdy(jbdy)%a_i(:,:) = 0._wp
	827	dta_bdy(jbdy)%h_i(:,:) = 0._wp
	828	dta_bdy(jbdy)%h_s(:,:) = 0._wp
[4292]	829	ENDIF
	830
	831	ENDIF
	832	ENDIF
[3294]	833	#endif
[6140]	834	!
[9019]	835	END DO ! jbdy
[6140]	836	!
	837	END SUBROUTINE bdy_dta_init
[911]	838
	839	!!==============================================================================
	840	END MODULE bdydta

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

Download in other formats: