Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

obcdta.F90 @ 2786

Last change on this file since 2786 was 1884, checked in by rblod, 14 years ago
Light adaptation of NEMO direct model routine to handle TAM
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 64.7 KB

Line
1	MODULE obcdta
2	!!==============================================================================
3	!! * MODULE obcdta *
4	!! Open boundary data : read the data for the open boundaries.
5	!!==============================================================================
6	#if defined key_obc
7	!!------------------------------------------------------------------------------
8	!! 'key_obc' : Open Boundary Conditions
9	!!------------------------------------------------------------------------------
10	!! obc_dta : read u, v, t, s data along each open boundary
11	!! obc_dta_psi : read psi data along each open boundary (rigid lid only)
12	!!------------------------------------------------------------------------------
13	!! * Modules used
14	USE oce ! ocean dynamics and tracers
15	USE dom_oce ! ocean space and time domain
16	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
17	USE phycst ! physical constants
18	USE obc_oce ! ocean open boundary conditions
19	USE daymod ! calendar
20	USE in_out_manager ! I/O logical units
21	USE lib_mpp ! distributed memory computing
22	USE dynspg_oce
23	USE ioipsl ! now only for ymds2ju function
24	USE iom !
25	USE obccli ! used when dynspg_rl
26
27	IMPLICIT NONE
28	PRIVATE
29
30	!! * Accessibility
31	PUBLIC obc_dta ! routines called by step.F90
32	PUBLIC obc_dta_bt ! routines called by dynspg_ts.F90
33
34	!! * Shared module variables
35	REAL(wp), DIMENSION(2) :: zjcnes_obc !
36	REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc
37	REAL(wp) :: rdt_obc
38	REAL(wp) :: zjcnes
39	INTEGER :: imm0, iyy0, idd0, iyy, imm, idd
40	INTEGER :: nt_a=2, nt_b=1, itobc, ndate0_cnes, nday_year0
41	INTEGER :: itobce, itobcw, itobcs, itobcn, itobc_b ! number of time steps in OBC files
42	REAL(wp) :: zraaj=365.
43
44	INTEGER :: &
45	ntobc , & !: where we are in the obc file
46	ntobc_b , & !: first record used
47	ntobc_a !: second record used
48
49	CHARACTER (len=40) :: & ! name of data files
50	cl_obc_eTS , cl_obc_eU, &
51	cl_obc_wTS , cl_obc_wU, &
52	cl_obc_nTS , cl_obc_nV, &
53	cl_obc_sTS , cl_obc_sV
54
55	! arrays used for interpolating time dependent data on the boundaries
56	REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uedta, vedta, tedta, sedta ! East
57	REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uwdta, vwdta, twdta, swdta ! West
58	REAL(wp), DIMENSION(jpi,jpk,jptobc) :: undta, vndta, tndta, sndta ! North
59	REAL(wp), DIMENSION(jpi,jpk,jptobc) :: usdta, vsdta, tsdta, ssdta ! South
60
61	LOGICAL, DIMENSION (jpj,jpk ) :: ltemsk=.TRUE., luemsk=.TRUE., lvemsk=.TRUE. ! boolean msks
62	LOGICAL, DIMENSION (jpj,jpk ) :: ltwmsk=.TRUE., luwmsk=.TRUE., lvwmsk=.TRUE. ! used for outliers
63	LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE. ! checks
64	LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE.
65
66	LOGICAL :: ln_obc_tangential=.FALSE.
67
68	!! * Substitutions
69	# include "obc_vectopt_loop_substitute.h90"
70	!!----------------------------------------------------------------------
71	!! OPA 9.0 , LOCEAN-IPSL (2006)
72	!! $Id$
73	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
74	!!----------------------------------------------------------------------
75
76	CONTAINS
77
78	SUBROUTINE obc_dta( kt )
79	!!---------------------------------------------------------------------------
80	!! * SUBROUTINE obc_dta *
81	!!
82	!! ** Purpose : Find the climatological boundary arrays for the specified date,
83	!! The boundary arrays are netcdf files. Three possible cases:
84	!! - one time frame only in the file (time dimension = 1).
85	!! in that case the boundary data does not change in time.
86	!! - many time frames. In that case, if we have 12 frames
87	!! we assume monthly fields.
88	!! Else, we assume that time_counter is in seconds
89	!! since the beginning of either the current year or a reference
90	!! year given in the namelist.
91	!! (no check is done so far but one would have to check the "unit"
92	!! attribute of variable time_counter).
93	!!
94	!!
95	!! History :
96	!! ! 98-05 (J.M. Molines) Original code
97	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
98	!!
99	!! 9.0 ! 04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input
100	!! ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data
101	!!---------------------------------------------------------------------------
102	!! * Arguments
103	INTEGER, INTENT( in ) :: kt ! ocean time-step index
104
105	!! * Local declarations
106	INTEGER :: ji, jj, jk, ii, ij ,it ! dummy loop indices
107	INTEGER :: ikprint ! frequency for printouts.
108	INTEGER, SAVE :: immfile, iyyfile !
109	INTEGER :: nt ! record indices (incrementation)
110	INTEGER :: istop ! local error check
111
112	REAL(wp) :: zxy, znum, zden ! time interpolation weight
113
114	! variables for the julian day calculation
115	INTEGER :: iyear, imonth, iday
116	REAL(wp) :: zsec , zjulian, zjuliancnes
117
118	! IOM STUFF
119	INTEGER :: idvar, id_e, id_w, id_n, id_s, id_x ! file identifiers
120	INTEGER, DIMENSION(1) :: itmp
121	CHARACTER(LEN=25) :: cl_vname
122
123	!!---------------------------------------------------------------------------
124	IF( lk_dynspg_rl ) THEN
125	CALL obc_dta_psi( kt ) ! update bsf data at open boundaries
126	IF ( nobc_dta == 1 .AND. kt == nit000 ) CALL ctl_stop( 'obcdta : time-variable psi boundary data not allowed yet' )
127	ENDIF
128
129	! 0. initialisation :
130	! --------------------
131	IF ( kt == nit000 ) CALL obc_dta_ini ( kt )
132	IF ( nobc_dta == 0 ) RETURN ! already done in obc_dta_ini
133	IF ( itobc == 1 ) RETURN ! case of only one time frame in file done in obc_dta_ini
134
135	! in the following code, we assume that obc data are read from files, with more than 1 time frame in it
136
137	iyyfile=iyy ; immfile = 00 ! set component of the current file name
138	IF ( cffile /= 'annual') immfile = imm !
139	IF ( ln_obc_clim ) iyyfile = 0000 ! assume that climatological files are labeled y0000
140
141	! 1. Synchronize time of run with time of data files
142	!---------------------------------------------------
143	! nday_year is the day number in the current year ( 1 for 01/01 )
144	zsec=MOD( (kt-nit000)rdt - (nday_year - nday_year0 )rday, rday ) ! number of seconds in the current day
145	IF (ln_obc_clim) THEN
146	zjcnes = nday_year - 1 + zsec/rday
147	ELSE
148	zjcnes = zjcnes + rdt/rday
149	ENDIF
150
151	! look for 'before' record number in the current file
152	ntobc = nrecbef () ! this function return the record number for 'before', relative to zjcnes
153
154	IF (MOD(kt-1,10)==0) THEN
155	IF (lwp) WRITE(numout,*) 'kt= ',kt,' zjcnes =', zjcnes,' ndastp =',ndastp, 'mm =',imm
156	END IF
157
158	! 2. read a new data if necessary
159	!--------------------------------
160	IF ( ntobc /= ntobc_b ) THEN
161	! we need to read the 'after' record
162	! swap working index:
163	nt=nt_b ; nt_b=nt_a ; nt_a=nt
164	ntobc_b = ntobc
165
166	! new record number :
167	ntobc_a = ntobc_a + 1
168
169	! all tricky things related to record number, changing files etc... are managed by obc_read
170
171	CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile )
172
173	! update zjcnes_obc
174	zjcnes_obc(nt_b)= ztcobc(ntobc_b)
175	zjcnes_obc(nt_a)= ztcobc(ntobc_a)
176	ENDIF
177
178	! 3. interpolation at each time step
179	! ------------------------------------
180	IF ( ln_obc_clim) THEN
181	znum= MOD(zjcnes - zjcnes_obc(nt_b), zraaj ) ; IF ( znum < 0 ) znum = znum + zraaj
182	zden= MOD(zjcnes_obc(nt_a) - zjcnes_obc(nt_b), zraaj ) ; IF ( zden < 0 ) zden = zden + zraaj
183	ELSE
184	znum= zjcnes - zjcnes_obc(nt_b)
185	zden= zjcnes_obc(nt_a) - zjcnes_obc(nt_b)
186	ENDIF
187	zxy = znum / zden
188
189	IF( lp_obc_east ) THEN
190	! fills sfoe, tfoe, ufoe ,vfoe
191	sfoe(:,:) = zxy * sedta (:,:,nt_a) + (1. - zxy)*sedta(:,:,nt_b)
192	tfoe(:,:) = zxy * tedta (:,:,nt_a) + (1. - zxy)*tedta(:,:,nt_b)
193	ufoe(:,:) = zxy * uedta (:,:,nt_a) + (1. - zxy)*uedta(:,:,nt_b)
194	vfoe(:,:) = zxy * vedta (:,:,nt_a) + (1. - zxy)*vedta(:,:,nt_b)
195	ENDIF
196
197	IF( lp_obc_west) THEN
198	! fills sfow, tfow, ufow ,vfow
199	sfow(:,:) = zxy * swdta (:,:,nt_a) + (1. - zxy)*swdta(:,:,nt_b)
200	tfow(:,:) = zxy * twdta (:,:,nt_a) + (1. - zxy)*twdta(:,:,nt_b)
201	ufow(:,:) = zxy * uwdta (:,:,nt_a) + (1. - zxy)*uwdta(:,:,nt_b)
202	vfow(:,:) = zxy * vwdta (:,:,nt_a) + (1. - zxy)*vwdta(:,:,nt_b)
203	ENDIF
204
205	IF( lp_obc_north) THEN
206	! fills sfon, tfon, ufon ,vfon
207	sfon(:,:) = zxy * sndta (:,:,nt_a) + (1. - zxy)*sndta(:,:,nt_b)
208	tfon(:,:) = zxy * tndta (:,:,nt_a) + (1. - zxy)*tndta(:,:,nt_b)
209	ufon(:,:) = zxy * undta (:,:,nt_a) + (1. - zxy)*undta(:,:,nt_b)
210	vfon(:,:) = zxy * vndta (:,:,nt_a) + (1. - zxy)*vndta(:,:,nt_b)
211	ENDIF
212
213	IF( lp_obc_south) THEN
214	! fills sfos, tfos, ufos ,vfos
215	sfos(:,:) = zxy * ssdta (:,:,nt_a) + (1. - zxy)*ssdta(:,:,nt_b)
216	tfos(:,:) = zxy * tsdta (:,:,nt_a) + (1. - zxy)*tsdta(:,:,nt_b)
217	ufos(:,:) = zxy * usdta (:,:,nt_a) + (1. - zxy)*usdta(:,:,nt_b)
218	vfos(:,:) = zxy * vsdta (:,:,nt_a) + (1. - zxy)*vsdta(:,:,nt_b)
219	ENDIF
220	END SUBROUTINE obc_dta
221
222
223	SUBROUTINE obc_dta_ini (kt)
224	!!-----------------------------------------------------------------------------
225	!! * SUBROUTINE obc_dta_ini *
226	!!
227	!! ** Purpose :
228	!! When obc_dta first call, realize some data initialization
229	!!
230	!! ** Method :
231	!!
232	!! History :
233	!! 9.0 ! 07-10 (J.M. Molines )
234	!!----------------------------------------------------------------------------
235	!! * Argument
236	INTEGER, INTENT(in) :: kt ! ocean time-step index
237
238	!! * Local declarations
239	INTEGER :: ji,jj, it ! dummy loop indices
240
241	REAL(wp) :: zxy ! time interpolation weight
242
243	INTEGER :: ikprint ! frequency for printouts.
244
245	INTEGER, SAVE :: immfile, iyyfile !
246	INTEGER :: nt ! record indices (incrementation)
247	INTEGER :: istop ! local error check
248
249	! variables for the julian day calculation
250	INTEGER :: iyear, imonth, iday
251	REAL(wp) :: zsec , zjulian, zjuliancnes
252
253	! IOM STUFF
254	INTEGER :: idvar, id_e, id_w, id_n, id_s, id_x ! file identifiers
255	INTEGER, DIMENSION(1) :: itmp
256	CHARACTER(LEN=25) :: cl_vname
257
258	IF(lwp) WRITE(numout,*)
259	IF(lwp) WRITE(numout,*) 'obc_dta : find boundary data'
260	IF(lwp) WRITE(numout,*) '~~~~~~~'
261	IF (lwp) THEN
262	IF ( nobc_dta == 0 ) THEN
263	WRITE(numout,*) ' OBC data taken from initial conditions.'
264	ELSE
265	WRITE(numout,*) ' OBC data taken from netcdf files.'
266	ENDIF
267	ENDIF
268	nday_year0 = nday_year ! to remember the day when kt=nit000
269	SELECT CASE (nleapy)
270	CASE ( 0 ) ; zraaj = 365.e0
271	CASE ( 1 ) ; zraaj = 366.e0 !! ERROR TO CORRECT: NOT EVERY YEAR IS LEAP YEAR !! JMM
272	CASE DEFAULT; zraaj = 12.* nleapy
273	END SELECT
274
275	sedta(:,:,:) = 0.e0 ; tedta(:,:,:) = 0.e0 ; uedta(:,:,:) = 0.e0 ; vedta(:,:,:) = 0.e0 ! East
276	swdta(:,:,:) = 0.e0 ; twdta(:,:,:) = 0.e0 ; uwdta(:,:,:) = 0.e0 ; vwdta(:,:,:) = 0.e0 ! West
277	sndta(:,:,:) = 0.e0 ; tndta(:,:,:) = 0.e0 ; undta(:,:,:) = 0.e0 ; vndta(:,:,:) = 0.e0 ! North
278	ssdta(:,:,:) = 0.e0 ; tsdta(:,:,:) = 0.e0 ; usdta(:,:,:) = 0.e0 ; vsdta(:,:,:) = 0.e0 ! South
279
280	sfoe(:,:) = 0.e0 ; tfoe(:,:) = 0.e0 ; ufoe(:,:) = 0.e0 ; vfoe(:,:) = 0.e0 ! East
281	sfow(:,:) = 0.e0 ; tfow(:,:) = 0.e0 ; ufow(:,:) = 0.e0 ; vfow(:,:) = 0.e0 ! West
282	sfon(:,:) = 0.e0 ; tfon(:,:) = 0.e0 ; ufon(:,:) = 0.e0 ; vfon(:,:) = 0.e0 ! North
283	sfos(:,:) = 0.e0 ; tfos(:,:) = 0.e0 ; ufos(:,:) = 0.e0 ; vfos(:,:) = 0.e0 ! South
284
285	IF (nobc_dta == 0 ) THEN ! boundary data are the initial data of this run (set only at nit000)
286	IF (lp_obc_east) THEN ! East
287	DO ji = nie0 , nie1
288	sfoe(nje0p1:nje1m1,:) = temsk(nje0p1:nje1m1,:) * sn (ji+1 , nje0p1:nje1m1 , :)
289	tfoe(nje0p1:nje1m1,:) = temsk(nje0p1:nje1m1,:) * tn (ji+1 , nje0p1:nje1m1 , :)
290	ufoe(nje0p1:nje1m1,:) = uemsk(nje0p1:nje1m1,:) * un (ji , nje0p1:nje1m1 , :)
291	vfoe(nje0p1:nje1m1,:) = vemsk(nje0p1:nje1m1,:) * vn (ji+1 , nje0p1:nje1m1 , :)
292	END DO
293	ENDIF
294
295	IF (lp_obc_west) THEN ! West
296	DO ji = niw0 , niw1
297	sfow(njw0p1:njw1m1,:) = twmsk(njw0p1:njw1m1,:) * sn (ji , njw0p1:njw1m1 , :)
298	tfow(njw0p1:njw1m1,:) = twmsk(njw0p1:njw1m1,:) * tn (ji , njw0p1:njw1m1 , :)
299	ufow(njw0p1:njw1m1,:) = uwmsk(njw0p1:njw1m1,:) * un (ji , njw0p1:njw1m1 , :)
300	vfow(njw0p1:njw1m1,:) = vwmsk(njw0p1:njw1m1,:) * vn (ji , njw0p1:njw1m1 , :)
301	END DO
302	ENDIF
303
304	IF (lp_obc_north) THEN ! North
305	DO jj = njn0 , njn1
306	sfon(nin0p1:nin1m1,:) = tnmsk(nin0p1:nin1m1,:) * sn (nin0p1:nin1m1 , jj+1 , :)
307	tfon(nin0p1:nin1m1,:) = tnmsk(nin0p1:nin1m1,:) * tn (nin0p1:nin1m1 , jj+1 , :)
308	ufon(nin0p1:nin1m1,:) = unmsk(nin0p1:nin1m1,:) * un (nin0p1:nin1m1 , jj+1 , :)
309	vfon(nin0p1:nin1m1,:) = vnmsk(nin0p1:nin1m1,:) * vn (nin0p1:nin1m1 , jj , :)
310	END DO
311	ENDIF
312
313	IF (lp_obc_south) THEN ! South
314	DO jj = njs0 , njs1
315	sfos(nis0p1:nis1m1,:) = tsmsk(nis0p1:nis1m1,:) * sn (nis0p1:nis1m1 , jj , :)
316	tfos(nis0p1:nis1m1,:) = tsmsk(nis0p1:nis1m1,:) * tn (nis0p1:nis1m1 , jj , :)
317	ufos(nis0p1:nis1m1,:) = usmsk(nis0p1:nis1m1,:) * un (nis0p1:nis1m1 , jj , :)
318	vfos(nis0p1:nis1m1,:) = vsmsk(nis0p1:nis1m1,:) * vn (nis0p1:nis1m1 , jj , :)
319	END DO
320	ENDIF
321	RETURN ! exit the routine all is done
322	ENDIF ! nobc_dta = 0
323
324	!!!! In the following OBC data are read from files.
325	! all logical-mask are initialzed to true when declared
326	WHERE ( temsk == 0 ) ltemsk=.FALSE.
327	WHERE ( uemsk == 0 ) luemsk=.FALSE.
328	WHERE ( vemsk == 0 ) lvemsk=.FALSE.
329
330	WHERE ( twmsk == 0 ) ltwmsk=.FALSE.
331	WHERE ( uwmsk == 0 ) luwmsk=.FALSE.
332	WHERE ( vwmsk == 0 ) lvwmsk=.FALSE.
333
334	WHERE ( tnmsk == 0 ) ltnmsk=.FALSE.
335	WHERE ( unmsk == 0 ) lunmsk=.FALSE.
336	WHERE ( vnmsk == 0 ) lvnmsk=.FALSE.
337
338	WHERE ( tsmsk == 0 ) ltsmsk=.FALSE.
339	WHERE ( usmsk == 0 ) lusmsk=.FALSE.
340	WHERE ( vsmsk == 0 ) lvsmsk=.FALSE.
341
342	iyear=1950; imonth=01; iday=01; zsec=0.
343	! zjuliancnes : julian day corresonding to 01/01/1950
344	CALL ymds2ju(iyear, imonth, iday,zsec , zjuliancnes)
345
346	!current year and curent month
347	iyy=INT(ndastp/10000) ; imm=INT((ndastp -iyy10000)/100) ; idd=(ndastp-iyy10000-imm*100)
348	IF (iyy < 1900) iyy = iyy+1900 ! always assume that years are on 4 digits.
349	CALL ymds2ju(iyy, imm, idd ,zsec , zjulian)
350	ndate0_cnes = zjulian - zjuliancnes ! jcnes day when call to obc_dta_ini
351
352	iyyfile=iyy ; immfile=0 ! set component of the current file name
353	IF ( cffile /= 'annual') immfile=imm
354	IF ( ln_obc_clim) iyyfile = 0 ! assume that climatological files are labeled y0000
355
356	CALL obc_dta_chktime ( iyyfile, immfile )
357
358	IF ( itobc == 1 ) THEN
359	! in this case we will provide boundary data only once.
360	nt_a=1 ; ntobc_a=1
361	CALL obc_read (nit000, nt_a, ntobc_a, iyyfile, immfile)
362	IF( lp_obc_east ) THEN
363	! fills sfoe, tfoe, ufoe ,vfoe
364	sfoe(:,:) = sedta (:,:,1) ; tfoe(:,:) = tedta (:,:,1)
365	ufoe(:,:) = uedta (:,:,1) ; vfoe(:,:) = vedta (:,:,1)
366	ENDIF
367
368	IF( lp_obc_west) THEN
369	! fills sfow, tfow, ufow ,vfow
370	sfow(:,:) = swdta (:,:,1) ; tfow(:,:) = twdta (:,:,1)
371	ufow(:,:) = uwdta (:,:,1) ; vfow(:,:) = vwdta (:,:,1)
372	ENDIF
373
374	IF( lp_obc_north) THEN
375	! fills sfon, tfon, ufon ,vfon
376	sfon(:,:) = sndta (:,:,1) ; tfon(:,:) = tndta (:,:,1)
377	ufon(:,:) = undta (:,:,1) ; vfon(:,:) = vndta (:,:,1)
378	ENDIF
379
380	IF( lp_obc_south) THEN
381	! fills sfos, tfos, ufos ,vfos
382	sfos(:,:) = ssdta (:,:,1) ; tfos(:,:) = tsdta (:,:,1)
383	ufos(:,:) = usdta (:,:,1) ; vfos(:,:) = vsdta (:,:,1)
384	ENDIF
385	RETURN ! we go out of obc_dta_ini -------------------------------------->>>>>
386	ENDIF
387
388	! nday_year is the day number in the current year ( 1 for 01/01 )
389	! we suppose that we always start from the begining of a day
390	! zsec=MOD( (kt-nit000)rdt - (nday_year - nday_year0 )rday, rday ) ! number of seconds in the current day
391	zsec=0.e0 ! here, kt=nit000, nday_year = ndat_year0
392
393	IF (ln_obc_clim) THEN
394	zjcnes = nday_year - 1 + zsec/rday ! for clim file time is in days in a year
395	ELSE
396	zjcnes = ndate0_cnes + (nday_year - nday_year0 ) + zsec/rday
397	ENDIF
398
399	! look for 'before' record number in the current file
400	ntobc = nrecbef ()
401
402	IF (lwp) WRITE(numout,*) 'obc files frequency :',cffile
403	IF (lwp) WRITE(numout,*) ' zjcnes0 =',zjcnes,' ndastp0 =',ndastp
404	IF (lwp) WRITE(numout,*) ' annee0 ',iyy,' month0 ', imm,' day0 ', idd
405	IF (lwp) WRITE(numout,*) 'first file open :',cl_obc_nTS
406
407	! record initialisation
408	!--------------------
409	nt_b = 1 ; nt_a = 2
410
411	ntobc_a = ntobc + 1
412	ntobc_b = ntobc
413
414	CALL obc_read (kt, nt_b, ntobc_b, iyyfile, immfile) ! read 'before' fields
415	CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile) ! read 'after' fields
416
417	zjcnes_obc(nt_b)= ztcobc(ntobc_b)
418	zjcnes_obc(nt_a)= ztcobc(ntobc_a)
419	!
420	END SUBROUTINE obc_dta_ini
421
422
423	SUBROUTINE obc_dta_chktime (kyyfile, kmmfile)
424	!
425	! check the number of time steps in the files and read ztcobc
426	!
427	! * Arguments
428	INTEGER, INTENT(in) :: kyyfile, kmmfile
429	! * local variables
430	INTEGER :: istop ! error control
431	INTEGER :: ji ! dummy loop index
432
433	INTEGER :: idvar, id_e, id_w, id_n, id_s, id_x ! file identifiers
434	INTEGER, DIMENSION(1) :: itmp
435	CHARACTER(LEN=25) :: cl_vname
436
437	ntobc_a = 0; itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0
438	! build file name
439	WRITE(cl_obc_eTS ,'("obc_east_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile
440	WRITE(cl_obc_wTS ,'("obc_west_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile
441	WRITE(cl_obc_nTS ,'("obc_north_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile
442	WRITE(cl_obc_sTS ,'("obc_south_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile
443
444	cl_vname = 'time_counter'
445	IF ( lp_obc_east ) THEN
446	CALL iom_open ( cl_obc_eTS , id_e )
447	idvar = iom_varid( id_e, cl_vname, kdimsz = itmp ); itobce=itmp(1)
448	ENDIF
449	IF ( lp_obc_west ) THEN
450	CALL iom_open ( cl_obc_wTS , id_w )
451	idvar = iom_varid( id_w, cl_vname, kdimsz = itmp ) ; itobcw=itmp(1)
452	ENDIF
453	IF ( lp_obc_north ) THEN
454	CALL iom_open ( cl_obc_nTS , id_n )
455	idvar = iom_varid( id_n, cl_vname, kdimsz = itmp ) ; itobcn=itmp(1)
456	ENDIF
457	IF ( lp_obc_south ) THEN
458	CALL iom_open ( cl_obc_sTS , id_s )
459	idvar = iom_varid( id_s, cl_vname, kdimsz = itmp ) ; itobcs=itmp(1)
460	ENDIF
461
462	itobc = MAX( itobce, itobcw, itobcn, itobcs )
463	istop = 0
464	IF ( lp_obc_east .AND. itobce /= itobc ) istop = istop+1
465	IF ( lp_obc_west .AND. itobcw /= itobc ) istop = istop+1
466	IF ( lp_obc_north .AND. itobcn /= itobc ) istop = istop+1
467	IF ( lp_obc_south .AND. itobcs /= itobc ) istop = istop+1
468	nstop = nstop + istop
469
470	IF ( istop /= 0 ) THEN
471	WRITE(ctmp1,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs
472	CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 )
473	ENDIF
474
475	IF ( itobc == 1 ) THEN
476	IF (lwp) THEN
477	WRITE(numout,*) ' obcdta found one time step only in the OBC files'
478	IF (ln_obc_clim) THEN
479	! OK no problem
480	ELSE
481	ln_obc_clim=.true.
482	WRITE(numout,*) ' we force ln_obc_clim to T'
483	ENDIF
484	ENDIF
485	ELSE
486	IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc )
487	ALLOCATE (ztcobc(itobc))
488	DO ji=1,1 ! use a dummy loop to read ztcobc only once
489	IF ( lp_obc_east ) THEN
490	CALL iom_gettime ( id_e, ztcobc, cl_vname ) ; CALL iom_close (id_e) ; EXIT
491	ENDIF
492	IF ( lp_obc_west ) THEN
493	CALL iom_gettime ( id_w, ztcobc, cl_vname ) ; CALL iom_close (id_w) ; EXIT
494	ENDIF
495	IF ( lp_obc_north ) THEN
496	CALL iom_gettime ( id_n, ztcobc, cl_vname ) ; CALL iom_close (id_n) ; EXIT
497	ENDIF
498	IF ( lp_obc_south ) THEN
499	CALL iom_gettime ( id_s, ztcobc, cl_vname ) ; CALL iom_close (id_s) ; EXIT
500	ENDIF
501	END DO
502	rdt_obc = ztcobc(2)-ztcobc(1) ! just an information, not used for any computation
503	IF (lwp) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files'
504	IF (lwp) WRITE(numout,*) ' time step of obc data :', rdt_obc,' days'
505	ENDIF
506	zjcnes = zjcnes - rdt/rday ! trick : zcnes is always incremented by rdt/rday in obc_dta!
507	END SUBROUTINE obc_dta_chktime
508
509	# if defined key_dynspg_rl
510	!!-----------------------------------------------------------------------------
511	!! Rigid-lid
512	!!-----------------------------------------------------------------------------
513
514	SUBROUTINE obc_dta_psi ( kt )
515	!!-----------------------------------------------------------------------------
516	!! * SUBROUTINE obc_dta_psi *
517	!!
518	!! ** Purpose :
519	!! Update the climatological streamfunction OBC at each time step.
520	!! Depends on the user's configuration. Here data are read only once
521	!! at the beginning of the run.
522	!!
523	!! ** Method :
524	!! 1. initialization
525	!! kbsfstart: number of time steps over which increase bsf
526	!! during initialization. This is provided for a smooth start
527	!! in cases where the transport is large (like on the Antarctic
528	!! continent). also note that when kbfstart=1, the transport
529	!! increases a lot in one time step and the precision usually
530	!! required for the solver may not be enough.
531	!! 2. set the time evolution of the climatological barotropic streamfunction
532	!! along the isolated coastlines ( gcbic(jnic) ).
533	!! 3. set the climatological barotropic streamfunction at the boundary.
534	!!
535	!! The last two steps are done only at first step (nit000) or if kt <= kbfstart
536	!!
537	!! History :
538	!! ! 97-08 (G. Madec, J.M. Molines)
539	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
540	!!----------------------------------------------------------------------------
541	!! * Arguments
542	INTEGER, INTENT( in ) :: kt ! ocean time-step index
543
544	!! * Local declarations
545	INTEGER :: ji, jj, jnic, jip ! dummy loop indices
546	INTEGER :: inum = 11 ! temporary logical unit
547	INTEGER :: ip, ii, ij, iii, ijj
548	INTEGER :: kbsfstart
549	REAL(wp) :: zsver1, zsver2, zsver3, z2dtr, zcoef
550	!!----------------------------------------------------------------------------
551
552	! 1. initialisation
553	! -----------------
554	kbsfstart = 1
555	zsver1 = bsfic0(1)
556	zsver2 = zsver1
557	IF( kt <= kbsfstart ) THEN
558	zcoef = float(kt)/float(kbsfstart)
559	ELSE
560	zcoef = 1.
561	END IF
562	bsfic(1) = zsver1*zcoef
563	IF( lwp .AND. ( kt <= kbsfstart ) ) THEN
564	IF(lwp) WRITE(numout,*)' '
565	IF(lwp) WRITE(numout,*)'obcdta: spinup phase in obc_dta_psi routine'
566	IF(lwp) WRITE(numout,*)'~~~~~~ it=',kt,' OBC: spinup coef: ', &
567	zcoef, ' and transport: ',bsfic(1)
568	END IF
569
570	zsver2 = bsfic(1)-bsfic(2)
571	zsver3 = bsfic(2)
572
573	! 2. Right hand side of the barotropic elliptic equation (isolated coastlines)
574	! ----------------------------------------------------------------------------
575
576	IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN
577	z2dtr = 1./rdt
578	ELSE
579	z2dtr = 1./2./rdt
580	END IF
581	! ... bsfb(ii,ij) should be constant but due to the Asselin filter it
582	! ... converges asymptotically towards bsfic(jnic)
583	! ... However, bsfb(ii,ij) is constant along the same coastlines
584	! ... ---> can be improved using an extra array for storing bsficb (before)
585	IF( nbobc > 1 ) THEN
586	DO jnic = 1,nbobc - 1
587	gcbic(jnic) = 0.
588	ip=mnic(0,jnic)
589	DO jip = 1,ip
590	ii = miic(jip,0,jnic)
591	ij = mjic(jip,0,jnic)
592	IF( ii >= nldi+ nimpp - 1 .AND. ii <= nlei+ nimpp - 1 .AND. &
593	ij >= nldj+ njmpp - 1 .AND. ij <= nlej+ njmpp - 1 ) THEN
594	iii=ii-nimpp+1
595	ijj=ij-njmpp+1
596	gcbic(jnic) = ( bsfic(jnic) - bsfb(iii,ijj) ) * z2dtr
597	END IF
598	END DO
599	END DO
600	END IF
601
602	IF( lk_mpp ) CALL mpp_isl( gcbic, 3 )
603
604	! 3. Update the climatological barotropic function at the boundary
605	! ----------------------------------------------------------------
606
607	IF( lpeastobc ) THEN
608
609	IF( kt == nit000 .OR. kt <= kbsfstart ) THEN
610	OPEN(inum,file='obceastbsf.dta')
611	READ(inum,*)
612	READ(inum,*)
613	READ(inum,*)
614	READ(inum,*)
615	READ(inum,*)
616	READ(inum,*) (bfoe(jj),jj=jpjed, jpjef)
617	CLOSE(inum)
618	END IF
619	DO jj=jpjed, jpjefm1
620	bfoe(jj)=bfoe(jj)*zcoef
621	END DO
622
623	END IF
624
625	IF( lpwestobc) THEN
626
627	IF( kt == nit000 .OR. kt <= kbsfstart ) THEN
628	OPEN(inum,file='obcwestbsf.dta')
629	READ(inum,*)
630	READ(inum,*)
631	READ(inum,*)
632	READ(inum,*)
633	READ(inum,*)
634	READ(inum,*) (bfow(jj),jj=jpjwd, jpjwf)
635	CLOSE(inum)
636	END IF
637	DO jj=jpjwd, jpjwfm1
638	bfow(jj)=bfow(jj)*zcoef
639	END DO
640
641	END IF
642
643	IF( lpsouthobc) THEN
644
645	IF( kt == nit000.OR.kt <= kbsfstart ) THEN
646	OPEN(inum,file='obcsouthbsf.dta')
647	READ(inum,*)
648	READ(inum,*)
649	READ(inum,*)
650	READ(inum,*)
651	READ(inum,*)
652	READ(inum,*) (bfos(jj),jj=jpisd, jpisf)
653	CLOSE(inum)
654	END IF
655	DO ji=jpisd, jpisfm1
656	bfos(ji)=bfos(ji)*zcoef
657	END DO
658
659	END IF
660
661	IF( lpnorthobc) THEN
662	IF( kt == nit000.OR.kt <= kbsfstart ) THEN
663	OPEN(inum,file='obcnorthbsf.dta')
664	READ(inum,*)
665	READ(inum,*)
666	READ(inum,*)
667	READ(inum,*)
668	READ(inum,*)
669	READ(inum,*) (bfon(jj),jj=jpind, jpinf)
670	CLOSE(inum)
671	END IF
672	DO ji=jpind, jpinfm1
673	bfon(ji)=bfon(ji)*zcoef
674	END DO
675
676	END IF
677	END SUBROUTINE obc_dta_psi
678
679	#else
680	!!-----------------------------------------------------------------------------
681	!! 'key_dynspg_rl not defined ( dynspg_flt or dynspg_exp or dynspg_ts )
682	!!-----------------------------------------------------------------------------
683	SUBROUTINE obc_dta_psi ( kt ) ! Empty routine
684	!! * Arguments
685	INTEGER,INTENT(in) :: kt
686	WRITE(,) 'obc_dta_psi: You should not have seen this print! error?', kt
687	STOP
688	END SUBROUTINE obc_dta_psi
689	# endif
690
691	#if defined key_dynspg_ts \|\| defined key_dynspg_exp
692	SUBROUTINE obc_dta_bt( kt, kbt )
693	!!---------------------------------------------------------------------------
694	!! * SUBROUTINE obc_dta *
695	!!
696	!! ** Purpose : time interpolation of barotropic data for time-splitting scheme
697	!! Data at the boundary must be in m2/s
698	!!
699	!! History :
700	!! 9.0 ! 05-11 (V. garnier) Original code
701	!!---------------------------------------------------------------------------
702	!! * Arguments
703	INTEGER, INTENT( in ) :: kt ! ocean time-step index
704	INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index
705
706	!! * Local declarations
707	INTEGER :: ji, jj, jk, ii, ij ! dummy loop indices
708	INTEGER :: id_e, id_w, id_n, id_s, fid ! file identifiers
709	INTEGER :: itimo, iman, imois, i15
710	INTEGER :: itobcm, itobcp, itimom, itimop
711	REAL(wp) :: zxy
712	INTEGER :: isrel, ikt ! number of seconds since 1/1/1992
713	INTEGER :: iprint ! frequency for printouts.
714
715	!!---------------------------------------------------------------------------
716
717	! 1. First call: check time frames available in files.
718	! -------------------------------------------------------
719
720	IF( kt == nit000 ) THEN
721
722	! 1.1 Barotropic tangential velocities set to zero
723	! -------------------------------------------------
724	IF( lp_obc_east ) vbtfoe(:) = 0.e0
725	IF( lp_obc_west ) vbtfow(:) = 0.e0
726	IF( lp_obc_south ) ubtfos(:) = 0.e0
727	IF( lp_obc_north ) ubtfon(:) = 0.e0
728
729	! 1.2 Sea surface height and normal barotropic velocities set to zero
730	! or initial conditions if nobc_dta == 0
731	! --------------------------------------------------------------------
732
733	IF( lp_obc_east ) THEN
734	! initialisation to zero
735	sshedta(:,:) = 0.e0
736	ubtedta(:,:) = 0.e0
737	! ! ================== !
738	IF( nobc_dta == 0 ) THEN ! initial state used !
739	! ! ================== !
740	! Fills sedta, tedta, uedta (global arrays)
741	! Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
742	DO ji = nie0, nie1
743	DO jj = nje0p1, nje1m1
744	ij = jj -1 + njmpp
745	sshedta(ij,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1)
746	END DO
747	END DO
748	ENDIF
749	ENDIF
750
751	IF( lp_obc_west) THEN
752	! initialisation to zero
753	sshwdta(:,:) = 0.e0
754	ubtwdta(:,:) = 0.e0
755	! ! ================== !
756	IF( nobc_dta == 0 ) THEN ! initial state used !
757	! ! ================== !
758	! Fills swdta, twdta, uwdta (global arrays)
759	! Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
760	DO ji = niw0, niw1
761	DO jj = njw0p1, njw1m1
762	ij = jj -1 + njmpp
763	sshwdta(ij,1) = sshn(ji,jj) * tmask(ji,jj,1)
764	END DO
765	END DO
766	ENDIF
767	ENDIF
768
769	IF( lp_obc_north) THEN
770	! initialisation to zero
771	sshndta(:,:) = 0.e0
772	vbtndta(:,:) = 0.e0
773	! ! ================== !
774	IF( nobc_dta == 0 ) THEN ! initial state used !
775	! ! ================== !
776	! Fills sndta, tndta, vndta (global arrays)
777	! Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
778	DO jj = njn0, njn1
779	DO ji = nin0p1, nin1m1
780	DO jk = 1, jpkm1
781	ii = ji -1 + nimpp
782	vbtndta(ii,1) = vbtndta(ii,1) + vndta(ii,jk,1)*fse3v(ji,jj,jk)
783	END DO
784	sshndta(ii,1) = sshn(ii,jj+1) * tmask(ji,jj+1,1)
785	END DO
786	END DO
787	ENDIF
788	ENDIF
789
790	IF( lp_obc_south) THEN
791	! initialisation to zero
792	ssdta(:,:,:) = 0.e0
793	tsdta(:,:,:) = 0.e0
794	vsdta(:,:,:) = 0.e0
795	sshsdta(:,:) = 0.e0
796	vbtsdta(:,:) = 0.e0
797	! ! ================== !
798	IF( nobc_dta == 0 ) THEN ! initial state used !
799	! ! ================== !
800	! Fills ssdta, tsdta, vsdta (global arrays)
801	! Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
802	DO jj = njs0, njs1
803	DO ji = nis0p1, nis1m1
804	DO jk = 1, jpkm1
805	ii = ji -1 + nimpp
806	vbtsdta(ii,1) = vbtsdta(ii,1) + vsdta(ii,jk,1)*fse3v(ji,jj,jk)
807	END DO
808	sshsdta(ii,1) = sshn(ji,jj) * tmask(ii,jj,1)
809	END DO
810	END DO
811	ENDIF
812	ENDIF
813
814	ENDIF ! END IF kt == nit000
815
816	!!------------------------------------------------------------------------------------
817	! 2. Initialize the time we are at. Does this every time the routine is called,
818	! excepted when nobc_dta = 0
819	!
820	IF( nobc_dta == 0) THEN
821	itimo = 1
822	zxy = 0
823	ELSE
824	IF(ntobc == 1) THEN
825	itimo = 1
826	ELSE IF (ntobc == 12) THEN ! BC are monthly
827	! we assume we have climatology in that case
828	iman = 12
829	i15 = nday / 16
830	imois = nmonth + i15 - 1
831	IF( imois == 0 ) imois = iman
832	itimo = imois
833	#if defined key_pomme_r025
834	ELSE IF ( ntobc == 14 ) THEN
835	i15 = nday / 16
836	imois = nmonth + i15 - 1
837	itimo = imois + 1 ! shift
838	#endif
839	ELSE
840	IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt
841	iman = ntobc
842	itimo = FLOOR( kt*rdt / tcobc(1))
843	isrel=kt*rdt
844	ENDIF
845	ENDIF
846
847	! 2. Read two records in the file if necessary
848	! ---------------------------------------------
849
850	IF( nobc_dta == 1 .AND. nlecto == 1 ) THEN
851
852	IF( lp_obc_east ) THEN
853	! ... Read datafile and set sea surface height and barotropic velocity
854	! ... initialise the sshedta, ubtedta arrays
855	sshedta(:,0) = sshedta(:,1)
856	ubtedta(:,0) = ubtedta(:,1)
857	CALL iom_open ( 'obceast_TS.nc', id_e )
858	CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,1), ktime=ntobc1 )
859	CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,2), ktime=ntobc2 )
860	IF( lk_dynspg_ts ) THEN
861	CALL iom_get (id_e, jpdom_unknown, 'vossurfh', sshedta(:,3), ktime=ntobc2+1 )
862	ENDIF
863	CALL iom_close ( id_e )
864	!
865	CALL iom_open ( 'obceast_U.nc', id_e )
866	CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,1), ktime=ntobc1 )
867	CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,2), ktime=ntobc2 )
868	IF( lk_dynspg_ts ) THEN
869	CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,3), ktime=ntobc2+1 )
870	ENDIF
871	CALL iom_close ( id_e )
872	! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1
873	IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
874	WRITE(numout,*)
875	WRITE(numout,*) ' Read East OBC barotropic data records ', ntobc1, ntobc2
876	iprint = (jpjef-jpjed+1)/20 +1
877	WRITE(numout,*)
878	WRITE(numout,*) ' Sea surface height record 1'
879	CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout )
880	WRITE(numout,*)
881	WRITE(numout,*) ' Normal transport (m2/s) record 1',iprint
882	CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout )
883	ENDIF
884	ENDIF
885
886	IF( lp_obc_west ) THEN
887	! ... Read datafile and set temperature, salinity and normal velocity
888	! ... initialise the swdta, twdta, uwdta arrays
889	sshwdta(:,0) = sshwdta(:,1)
890	ubtwdta(:,0) = ubtwdta(:,1)
891	CALL iom_open ( 'obcwest_TS.nc', id_w )
892	CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,1), ktime=ntobc1 )
893	CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,2), ktime=ntobc2 )
894	IF( lk_dynspg_ts ) THEN
895	CALL ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,3), ktime=ntobc2+1 )
896	ENDIF
897	CALL iom_close ( id_w )
898	!
899	CALL iom_open ( 'obcwest_U.nc', id_w )
900	CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,1), ktime=ntobc1 )
901	CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,2), ktime=ntobc2 )
902	IF( lk_dynspg_ts ) THEN
903	CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,3), ktime=ntobc2+1 )
904	ENDIF
905	CALL iom_close ( id_w )
906	! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1
907	IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
908	WRITE(numout,*)
909	WRITE(numout,*) ' Read West OBC barotropic data records ', ntobc1, ntobc2
910	iprint = (jpjwf-jpjwd+1)/20 +1
911	WRITE(numout,*)
912	WRITE(numout,*) ' Sea surface height record 1 - printout surface level'
913	CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout )
914	WRITE(numout,*)
915	WRITE(numout,*) ' Normal transport (m2/s) record 1'
916	CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout )
917	ENDIF
918	ENDIF
919
920	IF( lp_obc_north) THEN
921	! ... Read datafile and set sea surface height and barotropic velocity
922	! ... initialise the sshndta, ubtndta arrays
923	sshndta(:,0) = sshndta(:,1)
924	vbtndta(:,0) = vbtndta(:,1)
925	CALL iom_open ( 'obcnorth_TS.nc', id_n )
926	CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,1), ktime=ntobc1 )
927	CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,2), ktime=ntobc2 )
928	IF( lk_dynspg_ts ) THEN
929	CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,3), ktime=ntobc2+1 )
930	ENDIF
931	CALL iom_close ( id_n )
932
933	CALL iom_open ( 'obcnorth_V.nc', id_n )
934	CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,1), ktime=ntobc1 )
935	CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,2), ktime=ntobc2 )
936	IF( lk_dynspg_ts ) THEN
937	CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,3), ktime=ntobc2+1 )
938	ENDIF
939	CALL iom_close ( id_n )
940
941	! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1
942	IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
943	WRITE(numout,*)
944	WRITE(numout,*) ' Read North OBC barotropic data records ', ntobc1, ntobc2
945	iprint = (jpinf-jpind+1)/20 +1
946	WRITE(numout,*)
947	WRITE(numout,*) ' Sea surface height record 1 - printout surface level'
948	CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout )
949	WRITE(numout,*)
950	WRITE(numout,*) ' Normal transport (m2/s) record 1'
951	CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout )
952	ENDIF
953	ENDIF
954
955	IF( lp_obc_south) THEN
956	! ... Read datafile and set sea surface height and barotropic velocity
957	! ... initialise the sshsdta, ubtsdta arrays
958	sshsdta(:,0) = sshsdta(:,1)
959	vbtsdta(:,0) = vbtsdta(:,1)
960	CALL iom_open ( 'obcsouth_TS.nc', id_s )
961	CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,1), ktime=ntobc1 )
962	CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,2), ktime=ntobc2 )
963	IF( lk_dynspg_ts ) THEN
964	CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,3), ktime=ntobc2+1 )
965	ENDIF
966	CALL iom_close ( id_s )
967
968	CALL iom_open ( 'obcsouth_V.nc', id_s )
969	CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,1), ktime=ntobc1 )
970	CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,2), ktime=ntobc2 )
971	IF( lk_dynspg_ts ) THEN
972	CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,3), ktime=ntobc2+1 )
973	ENDIF
974	CALL iom_close ( id_s )
975
976	! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1
977	IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
978	WRITE(numout,*)
979	WRITE(numout,*) ' Read South OBC barotropic data records ', ntobc1, ntobc2
980	iprint = (jpisf-jpisd+1)/20 +1
981	WRITE(numout,*)
982	WRITE(numout,*) ' Sea surface height record 1 - printout surface level'
983	CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout )
984	WRITE(numout,*)
985	WRITE(numout,*) ' Normal transport (m2/s) record 1'
986	CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout )
987	ENDIF
988	ENDIF
989
990	ENDIF ! end of the test on the condition to read or not the files
991
992	! 3. Call at every time step : Linear interpolation of BCs to current time step
993	! ----------------------------------------------------------------------
994
995	IF( lk_dynspg_ts ) THEN
996	isrel = (kt-1)rdt + kbtrdtbt
997
998	IF( nobc_dta == 1 ) THEN
999	isrel = (kt-1)rdt + kbtrdtbt
1000	itimo = FLOOR( kt*rdt / (tcobc(2)-tcobc(1)) )
1001	itimom = FLOOR( (kt-1)*rdt / (tcobc(2)-tcobc(1)) )
1002	itimop = FLOOR( (kt+1)*rdt / (tcobc(2)-tcobc(1)) )
1003	IF( itimom == itimo .AND. itimop == itimo ) THEN
1004	itobcm = ntobc1
1005	itobcp = ntobc2
1006
1007	ELSEIF ( itimom <= itimo .AND. itimop == itimo ) THEN
1008	IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN
1009	itobcm = ntobc1-1
1010	itobcp = ntobc2-1
1011	ELSE
1012	itobcm = ntobc1
1013	itobcp = ntobc2
1014	ENDIF
1015
1016	ELSEIF ( itimom == itimo .AND. itimop >= itimo ) THEN
1017	IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN
1018	itobcm = ntobc1
1019	itobcp = ntobc2
1020	ELSE
1021	itobcm = ntobc1+1
1022	itobcp = ntobc2+1
1023	ENDIF
1024
1025	ELSEIF ( itimom == itimo-1 .AND. itimop == itimo+1 ) THEN
1026	IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN
1027	itobcm = ntobc1-1
1028	itobcp = ntobc2-1
1029	ELSEIF ( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN
1030	itobcm = ntobc1
1031	itobcp = ntobc2
1032	ELSEIF ( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) == itimop ) THEN
1033	itobcm = ntobc1+1
1034	itobcp = ntobc2+2
1035	ELSE
1036	IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 1?'
1037	ENDIF
1038	ELSE
1039	IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 2?'
1040	ENDIF
1041
1042	ENDIF
1043
1044	ELSE IF( lk_dynspg_exp ) THEN
1045	isrel=kt*rdt
1046	itobcm = ntobc1
1047	itobcp = ntobc2
1048	ENDIF
1049
1050	IF( ntobc == 1 .OR. nobc_dta == 0 ) THEN
1051	zxy = 0.e0
1052	ELSE IF( ntobc == 12 ) THEN
1053	zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
1054	ELSE
1055	zxy = (tcobc(itobcm)-FLOAT(isrel)) / (tcobc(itobcm)-tcobc(itobcp))
1056	ENDIF
1057
1058	IF( lp_obc_east ) THEN ! fills sshfoe, ubtfoe (local to each processor)
1059	DO jj = nje0p1, nje1m1
1060	ij = jj -1 + njmpp
1061	sshfoe(jj) = ( zxy * sshedta(ij,2) + (1.-zxy) * sshedta(ij,1) ) * temsk(jj,1)
1062	ubtfoe(jj) = ( zxy * ubtedta(ij,2) + (1.-zxy) * ubtedta(ij,1) ) * uemsk(jj,1)
1063	END DO
1064	ENDIF
1065
1066	IF( lp_obc_west) THEN ! fills sshfow, ubtfow (local to each processor)
1067	DO jj = njw0p1, njw1m1
1068	ij = jj -1 + njmpp
1069	sshfow(jj) = ( zxy * sshwdta(ij,2) + (1.-zxy) * sshwdta(ij,1) ) * twmsk(jj,1)
1070	ubtfow(jj) = ( zxy * ubtwdta(ij,2) + (1.-zxy) * ubtwdta(ij,1) ) * uwmsk(jj,1)
1071	END DO
1072	ENDIF
1073
1074	IF( lp_obc_north) THEN ! fills sshfon, vbtfon (local to each processor)
1075	DO ji = nin0p1, nin1m1
1076	ii = ji -1 + nimpp
1077	sshfon(ji) = ( zxy * sshndta(ii,2) + (1.-zxy) * sshndta(ii,1) ) * tnmsk(ji,1)
1078	vbtfon(ji) = ( zxy * vbtndta(ii,2) + (1.-zxy) * vbtndta(ii,1) ) * vnmsk(ji,1)
1079	END DO
1080	ENDIF
1081
1082	IF( lp_obc_south) THEN ! fills sshfos, vbtfos (local to each processor)
1083	DO ji = nis0p1, nis1m1
1084	ii = ji -1 + nimpp
1085	sshfos(ji) = ( zxy * sshsdta(ii,2) + (1.-zxy) * sshsdta(ii,1) ) * tsmsk(ji,1)
1086	vbtfos(ji) = ( zxy * vbtsdta(ii,2) + (1.-zxy) * vbtsdta(ii,1) ) * vsmsk(ji,1)
1087	END DO
1088	ENDIF
1089
1090	END SUBROUTINE obc_dta_bt
1091
1092	#else
1093	!!-----------------------------------------------------------------------------
1094	!! Default option
1095	!!-----------------------------------------------------------------------------
1096	SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine
1097	!! * Arguments
1098	INTEGER,INTENT(in) :: kt
1099	INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index
1100	WRITE(,) 'obc_dta_bt: You should not have seen this print! error?', kt
1101	WRITE(,) 'obc_dta_bt: You should not have seen this print! error?', kbt
1102	END SUBROUTINE obc_dta_bt
1103	#endif
1104
1105
1106	!!==============================================================================
1107	SUBROUTINE obc_read (kt, nt_x, ntobc_x, iyy, imm)
1108	!!-------------------------------------------------------------------------
1109	!! * ROUTINE obc_read *
1110	!!
1111	!! ** Purpose : Read the boundary data in files identified by iyy and imm
1112	!! According to the validated open boundaries, return the
1113	!! following arrays :
1114	!! sedta, tedta : East OBC salinity and temperature
1115	!! uedta, vedta : " " u and v velocity component
1116	!!
1117	!! swdta, twdta : West OBC salinity and temperature
1118	!! uwdta, vwdta : " " u and v velocity component
1119	!!
1120	!! sndta, tndta : North OBC salinity and temperature
1121	!! undta, vndta : " " u and v velocity component
1122	!!
1123	!! ssdta, tsdta : South OBC salinity and temperature
1124	!! usdta, vsdta : " " u and v velocity component
1125	!!
1126	!! ** Method : These fields are read in the record ntobc_x of the files.
1127	!! The number of records is already known. If ntobc_x is greater
1128	!! than the number of record, this routine will look for next file,
1129	!! updating the indices (case of inter-annual obcs) or loop at the
1130	!! begining in case of climatological file (ln_obc_clim = true ).
1131	!! -------------------------------------------------------------------------
1132	!! History: ! 2005 ( P. Mathiot, C. Langlais ) Original code
1133	!! ! 2008 ( J,M, Molines ) Use IOM and cleaning
1134	!!--------------------------------------------------------------------------
1135
1136	! * Arguments
1137	INTEGER, INTENT( in ) :: kt, nt_x
1138	INTEGER, INTENT( inout ) :: ntobc_x , iyy, imm ! yes ! inout !
1139
1140	! * Local variables
1141	CHARACTER (len=40) :: & ! file names
1142	cl_obc_eTS , cl_obc_eU, cl_obc_eV,&
1143	cl_obc_wTS , cl_obc_wU, cl_obc_wV,&
1144	cl_obc_nTS , cl_obc_nU, cl_obc_nV,&
1145	cl_obc_sTS , cl_obc_sU, cl_obc_sV
1146
1147	INTEGER :: ikprint
1148	REAL(wp) :: zmin, zmax ! control of boundary values
1149
1150	!IOM stuff
1151	INTEGER :: id_e, id_w, id_n, id_s, ji, jj
1152	INTEGER, DIMENSION(2) :: istart, icount
1153
1154	!--------------------------------------------------------------------------
1155	IF ( ntobc_x > itobc ) THEN
1156	IF (ln_obc_clim) THEN ! just loop on the same file
1157	ntobc_x = 1
1158	ELSE
1159	! need to change file : it is always for an 'after' data
1160	IF ( cffile == 'annual' ) THEN ! go to next year file
1161	iyy = iyy + 1
1162	ELSE IF ( cffile =='monthly' ) THEN ! go to next month file
1163	imm = imm + 1
1164	IF ( imm == 13 ) THEN
1165	imm = 1 ; iyy = iyy + 1
1166	ENDIF
1167	ELSE
1168	ctmp1='obcread : this type of obc file is not supported :( '
1169	ctmp2=TRIM(cffile)
1170	CALL ctl_stop (ctmp1, ctmp2)
1171	! cffile should be either annual or monthly ...
1172	ENDIF
1173	! as the file is changed, need to update itobc etc ...
1174	CALL obc_dta_chktime (iyy,imm)
1175	ntobc_x = nrecbef() + 1 ! remember : this case occur for an after data
1176	ENDIF
1177	ENDIF
1178
1179	IF ( lp_obc_east ) THEN
1180	! ... Read datafile and set temperature, salinity and normal velocity
1181	! ... initialise the sedta, tedta, uedta arrays
1182	WRITE(cl_obc_eTS ,'("obc_east_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1183	WRITE(cl_obc_eU ,'("obc_east_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1184	WRITE(cl_obc_eV ,'("obc_east_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1185	! JMM this may change depending on the obc data format ...
1186	istart(:)=(/nje0+njmpp-1,1/) ; icount(:)=(/nje1-nje0 +1,jpk/)
1187	IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_eTS)
1188	IF (nje1 >= nje0 ) THEN
1189	CALL iom_open ( cl_obc_eTS , id_e )
1190	CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(nje0:nje1,:,nt_x), &
1191	& ktime=ntobc_x , kstart=istart, kcount= icount )
1192	CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(nje0:nje1,:,nt_x), &
1193	& ktime=ntobc_x , kstart=istart, kcount= icount )
1194	CALL iom_close (id_e)
1195	!
1196	CALL iom_open ( cl_obc_eU , id_e )
1197	CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(nje0:nje1,:,nt_x), &
1198	& ktime=ntobc_x , kstart=istart, kcount= icount )
1199	CALL iom_close ( id_e )
1200	!
1201
1202	IF ( ln_obc_tangential ) THEN
1203	CALL iom_open ( cl_obc_eV , id_e )
1204	CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), &
1205	& ktime=ntobc_x , kstart=istart, kcount= icount )
1206	CALL iom_close ( id_e )
1207	ENDIF
1208
1209	! mask the boundary values
1210	tedta(:,:,nt_x) = tedta(:,:,nt_x)temsk(:,:) ; sedta(:,:,nt_x) = sedta(:,:,nt_x)temsk(:,:)
1211	uedta(:,:,nt_x) = uedta(:,:,nt_x)uemsk(:,:) ; vedta(:,:,nt_x) = vedta(:,:,nt_x)vemsk(:,:)
1212
1213	! check any outliers
1214	zmin=MINVAL( sedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(sedta(:,:,nt_x), mask=ltemsk)
1215	IF ( zmin < 5 .OR. zmax > 50) THEN
1216	CALL ctl_stop('Error in sedta',' routine obcdta')
1217	ENDIF
1218	zmin=MINVAL( tedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(tedta(:,:,nt_x), mask=ltemsk)
1219	IF ( zmin < -10. .OR. zmax > 40) THEN
1220	CALL ctl_stop('Error in tedta',' routine obcdta')
1221	ENDIF
1222	zmin=MINVAL( uedta(:,:,nt_x), mask=luemsk ) ; zmax=MAXVAL(uedta(:,:,nt_x), mask=luemsk)
1223	IF ( zmin < -5. .OR. zmax > 5.) THEN
1224	CALL ctl_stop('Error in uedta',' routine obcdta')
1225	ENDIF
1226	zmin=MINVAL( vedta(:,:,nt_x), mask=lvemsk ) ; zmax=MAXVAL(vedta(:,:,nt_x), mask=lvemsk)
1227	IF ( zmin < -5. .OR. zmax > 5.) THEN
1228	CALL ctl_stop('Error in vedta',' routine obcdta')
1229	ENDIF
1230
1231	! Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1
1232	IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
1233	WRITE(numout,*)
1234	WRITE(numout,*) ' Read East OBC data records ', ntobc_x
1235	ikprint = jpj/20 +1
1236	WRITE(numout,*) ' Temperature record 1 - printout every 3 level'
1237	CALL prihre( tedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1238	WRITE(numout,*)
1239	WRITE(numout,*) ' Salinity record 1 - printout every 3 level'
1240	CALL prihre( sedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1241	WRITE(numout,*)
1242	WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level'
1243	CALL prihre( uedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1244	WRITE(numout,*)
1245	WRITE(numout,*) ' Tangential velocity V record 1 - printout every 3 level'
1246	CALL prihre( vedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1247	ENDIF
1248	ENDIF
1249	ENDIF
1250	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1251	IF ( lp_obc_west ) THEN
1252	! ... Read datafile and set temperature, salinity and normal velocity
1253	! ... initialise the swdta, twdta, uwdta arrays
1254	WRITE(cl_obc_wTS ,'("obc_west_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1255	WRITE(cl_obc_wU ,'("obc_west_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1256	WRITE(cl_obc_wV ,'("obc_west_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1257	istart(:)=(/njw0+njmpp-1,1/) ; icount(:)=(/njw1-njw0 +1,jpk/)
1258	IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_wTS)
1259
1260	IF ( njw1 >= njw0 ) THEN
1261	CALL iom_open ( cl_obc_wTS , id_w )
1262	CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(njw0:njw1,:,nt_x), &
1263	& ktime=ntobc_x , kstart=istart, kcount= icount )
1264
1265	CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(njw0:njw1,:,nt_x), &
1266	& ktime=ntobc_x , kstart=istart, kcount= icount)
1267	CALL iom_close (id_w)
1268	!
1269	CALL iom_open ( cl_obc_wU , id_w )
1270	CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(njw0:njw1,:,nt_x),&
1271	& ktime=ntobc_x , kstart=istart, kcount= icount )
1272	CALL iom_close ( id_w )
1273	!
1274	IF ( ln_obc_tangential ) THEN
1275	CALL iom_open ( cl_obc_wV , id_w )
1276	CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), &
1277	& ktime=ntobc_x , kstart=istart, kcount= icount )
1278	CALL iom_close ( id_w )
1279	ENDIF
1280
1281	! mask the boundary values
1282	twdta(:,:,nt_x) = twdta(:,:,nt_x)twmsk(:,:) ; swdta(:,:,nt_x) = swdta(:,:,nt_x)twmsk(:,:)
1283	uwdta(:,:,nt_x) = uwdta(:,:,nt_x)uwmsk(:,:) ; vwdta(:,:,nt_x) = vwdta(:,:,nt_x)vwmsk(:,:)
1284
1285	! check any outliers
1286	zmin=MINVAL( swdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(swdta(:,:,nt_x), mask=ltwmsk)
1287	IF ( zmin < 5 .OR. zmax > 50) THEN
1288	CALL ctl_stop('Error in swdta',' routine obcdta')
1289	ENDIF
1290	zmin=MINVAL( twdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(twdta(:,:,nt_x), mask=ltwmsk)
1291	IF ( zmin < -10. .OR. zmax > 40) THEN
1292	CALL ctl_stop('Error in twdta',' routine obcdta')
1293	ENDIF
1294	zmin=MINVAL( uwdta(:,:,nt_x), mask=luwmsk ) ; zmax=MAXVAL(uwdta(:,:,nt_x), mask=luwmsk)
1295	IF ( zmin < -5. .OR. zmax > 5.) THEN
1296	CALL ctl_stop('Error in uwdta',' routine obcdta')
1297	ENDIF
1298	zmin=MINVAL( vwdta(:,:,nt_x), mask=lvwmsk ) ; zmax=MAXVAL(vwdta(:,:,nt_x), mask=lvwmsk)
1299	IF ( zmin < -5. .OR. zmax > 5.) THEN
1300	CALL ctl_stop('Error in vwdta',' routine obcdta')
1301	ENDIF
1302
1303
1304	IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
1305	WRITE(numout,*)
1306	WRITE(numout,*) ' Read West OBC data records ', ntobc_x
1307	ikprint = jpj/20 +1
1308	WRITE(numout,*) ' Temperature record 1 - printout every 3 level'
1309	CALL prihre( twdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1310	WRITE(numout,*)
1311	WRITE(numout,*) ' Salinity record 1 - printout every 3 level'
1312	CALL prihre( swdta(:,:,nt_x),jpj,jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1313	WRITE(numout,*)
1314	WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level'
1315	CALL prihre( uwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1316	WRITE(numout,*)
1317	WRITE(numout,*) ' Tangential velocity V record 1 - printout every 3 level'
1318	CALL prihre( vwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
1319	ENDIF
1320	END IF
1321	ENDIF
1322	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1323	IF( lp_obc_north) THEN
1324	WRITE(cl_obc_nTS ,'("obc_north_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1325	WRITE(cl_obc_nV ,'("obc_north_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1326	WRITE(cl_obc_nU ,'("obc_north_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1327	istart(:)=(/nin0+nimpp-1,1/) ; icount(:)=(/nin1-nin0 +1,jpk/)
1328	IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_nTS)
1329	IF ( nin1 >= nin0 ) THEN
1330	CALL iom_open ( cl_obc_nTS , id_n )
1331	CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(nin0:nin1,:,nt_x), &
1332	& ktime=ntobc_x , kstart=istart, kcount= icount )
1333	CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(nin0:nin1,:,nt_x), &
1334	& ktime=ntobc_x , kstart=istart, kcount= icount )
1335	CALL iom_close (id_n)
1336	!
1337	IF ( ln_obc_tangential ) THEN
1338	CALL iom_open ( cl_obc_nU , id_n )
1339	CALL iom_get ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), &
1340	& ktime=ntobc_x , kstart=istart, kcount= icount )
1341	CALL iom_close ( id_n )
1342	ENDIF
1343	!
1344	CALL iom_open ( cl_obc_nV , id_n )
1345	CALL iom_get ( id_n, jpdom_unknown, 'vomecrty', vndta(nin0:nin1,:,nt_x), &
1346	& ktime=ntobc_x , kstart=istart, kcount= icount )
1347	CALL iom_close ( id_n )
1348
1349	! mask the boundary values
1350	tndta(:,:,nt_x) = tndta(:,:,nt_x)tnmsk(:,:) ; sndta(:,:,nt_x) = sndta(:,:,nt_x)tnmsk(:,:)
1351	undta(:,:,nt_x) = undta(:,:,nt_x)unmsk(:,:) ; vndta(:,:,nt_x) = vndta(:,:,nt_x)vnmsk(:,:)
1352
1353	! check any outliers
1354	zmin=MINVAL( sndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(sndta(:,:,nt_x), mask=ltnmsk)
1355	IF ( zmin < 5 .OR. zmax > 50) THEN
1356	CALL ctl_stop('Error in sndta',' routine obcdta')
1357	ENDIF
1358	zmin=MINVAL( tndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(tndta(:,:,nt_x), mask=ltnmsk)
1359	IF ( zmin < -10. .OR. zmax > 40) THEN
1360	CALL ctl_stop('Error in tndta',' routine obcdta')
1361	ENDIF
1362	zmin=MINVAL( undta(:,:,nt_x), mask=lunmsk ) ; zmax=MAXVAL(undta(:,:,nt_x), mask=lunmsk)
1363	IF ( zmin < -5. .OR. zmax > 5.) THEN
1364	CALL ctl_stop('Error in undta',' routine obcdta')
1365	ENDIF
1366	zmin=MINVAL( vndta(:,:,nt_x), mask=lvnmsk ) ; zmax=MAXVAL(vndta(:,:,nt_x), mask=lvnmsk)
1367	IF ( zmin < -5. .OR. zmax > 5.) THEN
1368	CALL ctl_stop('Error in vndta',' routine obcdta')
1369	ENDIF
1370
1371	IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
1372	WRITE(numout,*)
1373	WRITE(numout,*) ' Read North OBC data records ', ntobc_x
1374	ikprint = jpi/20 +1
1375	WRITE(numout,*) ' Temperature record 1 - printout every 3 level'
1376	CALL prihre( tndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1377	WRITE(numout,*)
1378	WRITE(numout,*) ' Salinity record 1 - printout every 3 level'
1379	CALL prihre( sndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1380	WRITE(numout,*)
1381	WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level'
1382	CALL prihre( vndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1383	WRITE(numout,*)
1384	WRITE(numout,*) ' Tangential velocity U record 1 - printout every 3 level'
1385	CALL prihre( undta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1386	ENDIF
1387	ENDIF
1388	ENDIF
1389	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1390	IF( lp_obc_south) THEN
1391	WRITE(cl_obc_sTS ,'("obc_south_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1392	WRITE(cl_obc_sV ,'("obc_south_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1393	WRITE(cl_obc_sU ,'("obc_south_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
1394	istart(:)=(/nis0+nimpp-1,1/) ; icount(:)=(/nis1-nis0 +1,jpk/)
1395	IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_sTS)
1396	IF ( nis1 >= nis0 ) THEN
1397	CALL iom_open ( cl_obc_sTS , id_s )
1398	CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(nis0:nis1,:,nt_x), &
1399	& ktime=ntobc_x , kstart=istart, kcount= icount )
1400	CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(nis0:nis1,:,nt_x), &
1401	& ktime=ntobc_x , kstart=istart, kcount= icount )
1402	CALL iom_close (id_s)
1403	!
1404	IF ( ln_obc_tangential ) THEN
1405	CALL iom_open ( cl_obc_sU , id_s )
1406	CALL iom_get ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), &
1407	& ktime=ntobc_x , kstart=istart, kcount= icount )
1408	CALL iom_close ( id_s )
1409	ENDIF
1410	!
1411	CALL iom_open ( cl_obc_sV , id_s )
1412	CALL iom_get ( id_s, jpdom_unknown, 'vomecrty', vsdta(nis0:nis1,:,nt_x), &
1413	& ktime=ntobc_x , kstart=istart, kcount= icount )
1414	CALL iom_close ( id_s )
1415
1416	! mask the boundary values
1417	tsdta(:,:,nt_x) = tsdta(:,:,nt_x)tsmsk(:,:) ; ssdta(:,:,nt_x) = ssdta(:,:,nt_x)tsmsk(:,:)
1418	usdta(:,:,nt_x) = usdta(:,:,nt_x)usmsk(:,:) ; vsdta(:,:,nt_x) = vsdta(:,:,nt_x)vsmsk(:,:)
1419
1420	! check any outliers
1421	zmin=MINVAL( ssdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(ssdta(:,:,nt_x), mask=ltsmsk)
1422	IF ( zmin < 5 .OR. zmax > 50) THEN
1423	CALL ctl_stop('Error in ssdta',' routine obcdta')
1424	ENDIF
1425	zmin=MINVAL( tsdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(tsdta(:,:,nt_x), mask=ltsmsk)
1426	IF ( zmin < -10. .OR. zmax > 40) THEN
1427	CALL ctl_stop('Error in tsdta',' routine obcdta')
1428	ENDIF
1429	zmin=MINVAL( usdta(:,:,nt_x), mask=lusmsk ) ; zmax=MAXVAL(usdta(:,:,nt_x), mask=lusmsk)
1430	IF ( zmin < -5. .OR. zmax > 5.) THEN
1431	CALL ctl_stop('Error in usdta',' routine obcdta')
1432	ENDIF
1433	zmin=MINVAL( vsdta(:,:,nt_x), mask=lvsmsk ) ; zmax=MAXVAL(vsdta(:,:,nt_x), mask=lvsmsk)
1434	IF ( zmin < -5. .OR. zmax > 5.) THEN
1435	CALL ctl_stop('Error in vsdta',' routine obcdta')
1436	ENDIF
1437
1438	IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN
1439	WRITE(numout,*)
1440	WRITE(numout,*) ' Read South OBC data records ', ntobc_x
1441	ikprint = jpi/20 +1
1442	WRITE(numout,*) ' Temperature record 1 - printout every 3 level'
1443	CALL prihre( tsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1444	WRITE(numout,*)
1445	WRITE(numout,*) ' Salinity record 1 - printout every 3 level'
1446	CALL prihre( ssdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1447	WRITE(numout,*)
1448	WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level'
1449	CALL prihre( vsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1450	WRITE(numout,*)
1451	WRITE(numout,*) ' Tangential velocity U record 1 - printout every 3 level'
1452	CALL prihre( usdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
1453	ENDIF
1454	ENDIF
1455	ENDIF
1456	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1457	END SUBROUTINE obc_read
1458
1459	INTEGER FUNCTION nrecbef()
1460	!!-----------------------------------------------------------------------
1461	!! * FUNCTION nrecbef *
1462	!!
1463	!! Purpose : - provide the before record number in files, with respect to zjcnes
1464	!!
1465	!! History : 2008-04 : ( J.M. Molines ) Original code
1466	!!-----------------------------------------------------------------------
1467
1468	INTEGER :: it , idum
1469
1470	idum = itobc
1471	DO it =1, itobc
1472	IF ( ztcobc(it) > zjcnes ) THEN ; idum = it - 1 ; EXIT ; ENDIF
1473	ENDDO
1474	! idum can be 0 (climato, before first record)
1475	IF ( idum == 0 ) THEN
1476	IF ( ln_obc_clim ) THEN
1477	idum = itobc
1478	ELSE
1479	ctmp1='obc_dta: find ntobc == 0 for non climatological file '
1480	ctmp2='consider adding a first record in your data file '
1481	CALL ctl_stop(ctmp1, ctmp2)
1482	ENDIF
1483	ENDIF
1484	! idum can be itobc ( zjcnes > ztcobc (itobc) )
1485	! This is not a problem ...
1486	nrecbef = idum
1487
1488	END FUNCTION nrecbef
1489
1490	#else
1491	!!------------------------------------------------------------------------------
1492	!! default option: Dummy module NO Open Boundary Conditions
1493	!!------------------------------------------------------------------------------
1494	CONTAINS
1495	SUBROUTINE obc_dta( kt ) ! Dummy routine
1496	INTEGER, INTENT (in) :: kt
1497	WRITE(,) 'obc_dta: You should not have seen this print! error?', kt
1498	END SUBROUTINE obc_dta
1499	#endif
1500	END MODULE obcdta

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

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

Context Navigation

source: branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcdta.F90 @ 2786

Download in other formats: