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.

dtadyn.F90 in trunk/NEMO/OFF_SRC – NEMO

Context Navigation

source: trunk/NEMO/OFF_SRC/dtadyn.F90 @ 390

Last change on this file since 390 was 382, checked in by opalod, 18 years ago

nemo_v1_bugfix_021:CE+RB: bug in the definition of the vertical grid (partial step)

bad read of the time step

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 30.0 KB

Line
1	MODULE dtadyn
2	!!======================================================================
3	!! * MODULE dtadyn *
4	!! OFFLINE : interpolation of the physical fields
5	!!=====================================================================
6
7	!!----------------------------------------------------------------------
8	!! dta_dyn_init : initialization, namelist read, and parameters control
9	!! dta_dyn : Interpolation of the fields
10	!!----------------------------------------------------------------------
11	!! * Modules used
12	USE oce ! ocean dynamics and tracers variables
13	USE dom_oce ! ocean space and time domain variables
14	USE zdf_oce ! ocean vertical physics
15	USE in_out_manager ! I/O manager
16	USE phycst ! physical constants
17	USE ocesbc
18	USE ldfslp
19	USE blk_oce
20	USE zdfmxl
21	USE trabbl ! tracers: bottom boundary layer
22	USE ldftra_oce
23	USE ocfzpt
24	USE zdfddm ! vertical physics: double diffusion
25	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
26	USE lib_mpp ! distributed memory computing library
27
28	IMPLICIT NONE
29	PRIVATE
30
31	!! * Routine accessibility
32	PUBLIC dta_dyn_init ! called by opa.F90
33	PUBLIC dta_dyn ! called by step.F90
34
35	!! * Module variables
36	INTEGER , PUBLIC, PARAMETER :: jpflx = 13
37	INTEGER , PUBLIC, PARAMETER :: &
38	jptaux = 1 , & ! indice in flux for taux
39	jptauy = 2 , & ! indice in flux for tauy
40	jpwind = 3 , & ! indice in flux for wspd
41	jpemp = 4 , & ! indice in flux for E-P
42	jpice = 5 , & ! indice in flux for ice concentration
43	jpqsr = 6 ! indice in flux for shortwave heat flux
44
45	LOGICAL , PUBLIC :: &
46	lperdyn = .TRUE. , & ! boolean for periodic fields or not
47	lfirdyn = .TRUE. ! boolean for the first call or not
48
49	INTEGER , PUBLIC :: &
50	ndtadyn = 12 , & ! Number of dat in one year
51	ndtatot = 12 , & ! Number of data in the input field
52	nsptint = 1 , & ! type of spatial interpolation
53	nficdyn = 2 ! number of dynamical fields
54
55	INTEGER :: ndyn1, ndyn2 , &
56	nlecoff = 0 , & ! switch for the first read
57	numfl_t, numfl_u, &
58	numfl_v, numfl_w, numfl_s
59
60
61	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
62	tdta , & ! temperature at two consecutive times
63	sdta , & ! salinity at two consecutive times
64	udta , & ! zonal velocity at two consecutive times
65	vdta , & ! meridional velocity at two consecutive times
66	wdta , & ! vertical velocity at two consecutive times
67	avtdta ! vertical diffusivity coefficient
68
69	#if defined key_ldfslp
70	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
71	uslpdta , & ! zonal isopycnal slopes
72	vslpdta , & ! meridional isopycnal slopes
73	wslpidta , & ! zonal diapycnal slopes
74	wslpjdta ! meridional diapycnal slopes
75	#endif
76
77	REAL(wp), DIMENSION(jpi,jpj,jpflx,2) :: &
78	flxdta ! auxiliary 2-D forcing fields at two consecutive times
79	REAL(wp), DIMENSION(jpi,jpj,2) :: &
80	zmxldta ! mixed layer depth at two consecutive times
81
82	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
83	REAL(wp), DIMENSION(jpi,jpj,2) :: &
84	bblxdta , & ! frequency of bbl in the x direction at 2 consecutive times
85	bblydta ! frequency of bbl in the y direction at 2 consecutive times
86	#endif
87
88
89	!! * Substitutions
90	# include "domzgr_substitute.h90"
91	# include "vectopt_loop_substitute.h90"
92	!!----------------------------------------------------------------------
93	!! OPA 9.0 , LOCEAN-IPSL (2005)
94	!! $Header$
95	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
96	!!----------------------------------------------------------------------
97
98	CONTAINS
99
100	SUBROUTINE dta_dyn_init
101	!!----------------------------------------------------------------------
102	!! * ROUTINE dta_dyn_init *
103	!!
104	!! ** Purpose : initializations of parameters for the interpolation
105	!!
106	!! ** Method :
107	!!
108	!! History :
109	!! ! original : 92-01 (M. Imbard: sub domain)
110	!! ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
111	!! ! 98-05 (L. Bopp read output of coupled run)
112	!! ! 05-03 (O. Aumont and A. El Moussaoui) F90
113	!!----------------------------------------------------------------------
114	!! * Modules used
115
116	!! * Local declarations
117
118
119	NAMELIST/nam_offdyn/ ndtadyn, ndtatot, nsptint, &
120	& nficdyn, lperdyn
121	!!----------------------------------------------------------------------
122
123	! Define the dynamical input parameters
124	! ======================================
125
126	! Read Namelist nam_offdyn : Lateral physics on tracers
127	REWIND( numnam )
128	READ ( numnam, nam_offdyn )
129
130	IF(lwp) THEN
131	WRITE(numout,*)
132	WRITE(numout,*) 'nam_offdyn : offline dynamical selection'
133	WRITE(numout,*) '~~~~~~~'
134	WRITE(numout,*) ' Namelist nam_offdyn : set parameters for the lecture of the dynamical fields'
135	WRITE(numout,*)
136	WRITE(numout,*) ' number of elements in the FILE for a year ndtadyn = ' , ndtadyn
137	WRITE(numout,*) ' total number of elements in the FILE ndtatot = ' , ndtatot
138	WRITE(numout,*) ' type of interpolation nsptint = ' , nsptint
139	WRITE(numout,*) ' number of dynamics FILE nficdyn = ' , nficdyn
140	WRITE(numout,*) ' loop on the same FILE lperdyn = ' , lperdyn
141	WRITE(numout,*) ' '
142	ENDIF
143
144	END SUBROUTINE dta_dyn_init
145
146	SUBROUTINE dta_dyn(kt)
147	!!----------------------------------------------------------------------
148	!! * ROUTINE dta_dyn *
149	!!
150	!! ** Purpose : Prepares dynamics and physics fields from an
151	!! OPA9 simulation for an off-line simulation
152	!! for passive tracer
153	!!
154	!! ** Method : calculates the position of DATA to read READ DATA
155	!! (example month changement) computes slopes IF needed
156	!! interpolates DATA IF needed
157	!!
158	!! ** History :
159	!! ! original : 92-01 (M. Imbard: sub domain)
160	!! ! addition : 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
161	!! ! addition : 98-05 (L. Bopp read output of coupled run)
162	!! ! addition : 05-03 (O. Aumont and A. El Moussaoui) F90
163	!!----------------------------------------------------------------------
164	!! * Modules used
165	USE eosbn2
166
167	!! * Arguments
168	INTEGER, INTENT( in ) :: kt ! ocean time-step index
169
170	!! * Local declarations
171	INTEGER :: iper, iperm1, iswap
172
173	REAL(wp) :: zpdtan, zpdtpe, zdemi, zt
174	REAL(wp) :: zweigh, zweighm1
175
176	REAL(wp), DIMENSION(jpi,jpj,jpflx) :: &
177	flx ! auxiliary field for 2-D surface boundary conditions
178
179
180	! 0. Initialization
181	! -----------------
182
183	zpdtan = raass / rdt
184	zpdtpe = ((zpdtan / FLOAT (ndtadyn)))
185	zdemi = zpdtpe * 0.5
186	zt = (FLOAT (kt) + zdemi ) / zpdtpe
187
188	zweigh = zt - FLOAT(INT(zt))
189	zweighm1 = 1. - zweigh
190
191	IF (lperdyn) THEN
192	iperm1 = MOD(INT(zt),ndtadyn)
193	ELSE
194	iperm1 = MOD(INT(zt),(ndtatot-1))
195	ENDIF
196	iper = iperm1 + 1
197	IF (iperm1 == 0) THEN
198	IF (lperdyn) THEN
199	iperm1 = ndtadyn
200	ELSE
201	IF (lfirdyn) THEN
202	IF (lwp) THEN
203	WRITE (numout,*) ' dynamic file is not periodic '
204	WRITE (numout,*) ' with or without interpolation, '
205	WRITE (numout,*) ' we take the first value'
206	WRITE (numout,*) ' for the previous period '
207	WRITE (numout,*) ' iperm1 = 0 '
208	END IF
209	END IF
210	END IF
211	END IF
212
213	iswap = 0
214
215	! 1. First call lfirdyn = true
216	! ----------------------------
217
218	IF (lfirdyn) THEN
219	!
220	! time step MUST BE nint000
221	!
222	IF( kt .NE. nit000 ) THEN
223	IF (lwp) THEN
224	WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt=',kt &
225	,' nit000=',nit000
226	END IF
227	STOP 'dtadyn'
228	END if
229	! Initialize the parameters of the interpolation
230	CALL dta_dyn_init
231	!
232	! store the information of the period read
233	!
234	ndyn1 = iperm1
235	ndyn2 = iper
236
237	IF (lwp) THEN
238	WRITE (numout,*) &
239	' dynamics DATA READ for the period ndyn1 =',ndyn1, &
240	& ' and for the period ndyn2 = ',ndyn2
241	WRITE (numout,*) ' time step is :',kt
242	WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,&
243	& ' records in the dynamic FILE for one year'
244	END IF
245	!
246	! DATA READ for the iperm1 period
247	!
248	IF( iperm1 .NE. 0 ) THEN
249	CALL dynrea( kt, iperm1 )
250	ELSE
251	CALL dynrea( kt, 1 )
252	ENDIF
253	!
254	! Computes dynamical fields
255	!
256	tn(:,:,:)=tdta(:,:,:,2)
257	sn(:,:,:)=sdta(:,:,:,2)
258	avt(:,:,:)=avtdta(:,:,:,2)
259
260
261
262	IF(lwp) THEN
263	WRITE(numout,*)' temperature '
264	WRITE(numout,*)
265	CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
266	WRITE(numout,*)
267	WRITE(numout,*) ' level = ',jpk/2
268	CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
269	WRITE(numout,*)
270	WRITE(numout,*) ' level = ',jpkm1
271	CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
272	WRITE(numout,*)
273	WRITE(numout,*)' salinity '
274	WRITE(numout,*)
275	CALL prihre(sn(1,1,1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
276	WRITE(numout,*)
277	WRITE(numout,*) ' level = ',jpk/2
278	CALL prihre(sn(1,1,jpk/2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
279	WRITE(numout,*)
280	WRITE(numout,*) ' level = ',jpkm1
281	CALL prihre(sn(1,1,jpkm1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
282	WRITE(numout,*)
283	WRITE(numout,*)' Kz '
284	WRITE(numout,*)
285	CALL prihre(avtdta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
286	WRITE(numout,*)
287	WRITE(numout,*) ' level = ',jpk/2
288	CALL prihre(avtdta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
289	WRITE(numout,*)
290	WRITE(numout,*) ' level = ',jpkm1
291	CALL prihre(avtdta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
292	WRITE(numout,*)
293	WRITE(numout,*)' zonal wind '
294	WRITE(numout,*)
295	CALL prihre(udta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
296	WRITE(numout,*)
297	WRITE(numout,*) ' level = ',jpk/2
298	CALL prihre(udta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
299	WRITE(numout,*)
300	WRITE(numout,*) ' level = ',jpkm1
301	CALL prihre(udta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
302	WRITE(numout,*)
303	WRITE(numout,*)' meridional wind '
304	WRITE(numout,*)
305	CALL prihre(vdta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
306	WRITE(numout,*)
307	WRITE(numout,*) ' level = ',jpk/2
308	CALL prihre(vdta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
309	WRITE(numout,*)
310	WRITE(numout,*) ' level = ',jpkm1
311	CALL prihre(vdta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
312	WRITE(numout,*)
313	WRITE(numout,*)' vertical volocity '
314	WRITE(numout,*)
315	CALL prihre(wdta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
316	WRITE(numout,*)
317	WRITE(numout,*) ' level = ',jpk/2
318	CALL prihre(wdta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
319	WRITE(numout,*)
320	WRITE(numout,*) ' level = ',jpkm1
321	CALL prihre(wdta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
322	WRITE(numout,*)
323	WRITE(numout,*)' Wind '
324	CALL prihre(flxdta(1,1,jpwind,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
325	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
326	WRITE(numout,*)
327	WRITE(numout,*)' BBL zonal'
328	CALL prihre(bblxdta(1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
329	WRITE(numout,*)
330	WRITE(numout,*)' BBL meridional'
331	CALL prihre(bblydta(1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout)
332
333	#endif
334
335	ENDIF
336
337	#if defined key_ldfslp
338	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
339	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
340	CALL zdf_mxl( kt ) ! mixed layer depth
341	CALL ldf_slp( kt, rhd, rn2 )
342
343	uslpdta(:,:,:,2)=uslp(:,:,:)
344	vslpdta(:,:,:,2)=vslp(:,:,:)
345	wslpidta(:,:,:,2)=wslpi(:,:,:)
346	wslpjdta(:,:,:,2)=wslpj(:,:,:)
347	#endif
348	!
349	! swap from record 2 to 1
350	!
351	udta(:,:,:,1)=udta(:,:,:,2)
352	vdta(:,:,:,1)=vdta(:,:,:,2)
353	wdta(:,:,:,1)=wdta(:,:,:,2)
354	avtdta(:,:,:,1)=avtdta(:,:,:,2)
355	tdta(:,:,:,1)=tdta(:,:,:,2)
356	sdta(:,:,:,1)=sdta(:,:,:,2)
357	#if defined key_ldfslp
358	uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
359	vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
360	wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
361	wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
362	#endif
363	flxdta(:,:,:,1) = flxdta(:,:,:,2)
364	zmxldta(:,:,1)=zmxldta(:,:,2)
365
366	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
367	bblxdta(:,:,1)=bblxdta(:,:,2)
368	bblydta(:,:,1)=bblydta(:,:,2)
369	#endif
370
371
372	!
373	! indicates a swap
374	!
375	iswap = 1
376	!
377	! DATA READ for the iper period
378	!
379	CALL dynrea(kt,iper)
380	!
381	! Computes wdta (and slopes if key_trahdfiso)
382	!
383	tn(:,:,:)=tdta(:,:,:,2)
384	sn(:,:,:)=sdta(:,:,:,2)
385	avt(:,:,:)=avtdta(:,:,:,2)
386
387
388	#if defined key_ldfslp
389	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
390	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
391	CALL zdf_mxl( kt ) ! mixed layer depth
392	CALL ldf_slp( kt, rhd, rn2 )
393
394	uslpdta(:,:,:,2)=uslp(:,:,:)
395	vslpdta(:,:,:,2)=vslp(:,:,:)
396	wslpidta(:,:,:,2)=wslpi(:,:,:)
397	wslpjdta(:,:,:,2)=wslpj(:,:,:)
398	#endif
399	!
400	! trace the first CALL
401	!
402	lfirdyn=.FALSE.
403	ENDIF
404	!
405	! and now what we have to DO at every time step
406	!
407	! check the validity of the period in memory
408	!
409	IF (iperm1.NE.ndyn1) THEN
410	IF (iperm1.EQ.0.) THEN
411	IF (lwp) THEN
412	WRITE (numout,*) ' dynamic file is not periodic '
413	WRITE (numout,*) ' with or without interpolation, '
414	WRITE (numout,*) ' we take the last value'
415	WRITE (numout,*) ' for the last period '
416	WRITE (numout,*) ' iperm1 = 12 '
417	WRITE (numout,*) ' iper = 13'
418	ENDIF
419	iperm1 = 12
420	iper =13
421	ENDIF
422	!
423	! we have to prepare a NEW READ of DATA
424	!
425	! swap from record 2 to 1
426	!
427	udta(:,:,:,1)=udta(:,:,:,2)
428	vdta(:,:,:,1)=vdta(:,:,:,2)
429	wdta(:,:,:,1)=wdta(:,:,:,2)
430	avtdta(:,:,:,1)=avtdta(:,:,:,2)
431	tdta(:,:,:,1)=tdta(:,:,:,2)
432	sdta(:,:,:,1)=sdta(:,:,:,2)
433	#if defined key_ldfslp
434	uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
435	vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
436	wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
437	wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
438	#endif
439	flxdta(:,:,:,1) = flxdta(:,:,:,2)
440	zmxldta(:,:,1)=zmxldta(:,:,2)
441
442	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
443	bblxdta(:,:,1)=bblxdta(:,:,2)
444	bblydta(:,:,1)=bblydta(:,:,2)
445	#endif
446
447
448	!
449	! indicates a swap
450	!
451	iswap = 1
452	!
453	! READ DATA for the iper period
454	!
455	CALL dynrea(kt,iper)
456	!
457	! Computes wdta (and slopes if key_trahdfiso)
458	!
459	tn(:,:,:)=tdta(:,:,:,2)
460	sn(:,:,:)=sdta(:,:,:,2)
461	avt(:,:,:)=avtdta(:,:,:,2)
462
463	#if defined key_ldfslp
464	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
465	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
466	CALL zdf_mxl( kt ) ! mixed layer depth
467	CALL ldf_slp( kt, rhd, rn2 )
468
469	uslpdta(:,:,:,2)=uslp(:,:,:)
470	vslpdta(:,:,:,2)=vslp(:,:,:)
471	wslpidta(:,:,:,2)=wslpi(:,:,:)
472	wslpjdta(:,:,:,2)=wslpj(:,:,:)
473	#endif
474	!
475	! store the information of the period read
476	!
477	ndyn1 = ndyn2
478	ndyn2 = iper
479	!
480	! we have READ another period of DATA
481	!
482	IF (lwp) THEN
483	WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1
484	WRITE (numout,*) ' and the period ndyn2 = ',ndyn2
485	WRITE (numout,*) ' time step is :',kt
486	END IF
487
488	END IF
489
490	!
491	! compute the DATA at the given time step
492	!
493	IF (nsptint.eq.0) THEN
494	!
495	! no spatial interpolation
496	!
497	! DATA are probably correct
498	! we have to initialize DATA IF we have changed the period
499	!
500	IF (iswap.eq.1) THEN
501	!
502	! initialize now fields with the NEW DATA READ
503	!
504	un(:,:,:)=udta(:,:,:,2)
505	vn(:,:,:)=vdta(:,:,:,2)
506	wn(:,:,:)=wdta(:,:,:,2)
507	#if defined key_trc_zdfddm
508	avs(:,:,:)=avtdta(:,:,:,2)
509	#endif
510	avt(:,:,:)=avtdta(:,:,:,2)
511	tn(:,:,:)=tdta(:,:,:,2)
512	sn(:,:,:)=sdta(:,:,:,2)
513	#if defined key_ldfslp
514	uslp(:,:,:)=uslpdta(:,:,:,2)
515	vslp(:,:,:)=vslpdta(:,:,:,2)
516	wslpi(:,:,:)=wslpidta(:,:,:,2)
517	wslpj(:,:,:)=wslpjdta(:,:,:,2)
518	#endif
519
520	flx(:,:,:) = flxdta(:,:,:,2)
521	hmld(:,:)=zmxldta(:,:,2)
522
523	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
524	bblx(:,:)=bblxdta(:,:,2)
525	bbly(:,:)=bblydta(:,:,2)
526	#endif
527
528	!
529	! keep needed fluxes
530	!
531	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily
532	vatm(:,:) = flx(:,:,jpwind)
533	#endif
534	freeze(:,:) = flx(:,:,jpice)
535	emp(:,:) = flx(:,:,jpemp)
536	qsr(:,:) = flx(:,:,jpqsr)
537
538	END IF
539
540	ELSE
541	IF (nsptint.eq.1) THEN
542	!
543	! linear interpolation
544	!
545	! initialize now fields with a linear interpolation
546	!
547	un(:,:,:) = zweighm1 * udta(:,:,:,1) + zweigh * udta(:,:,:,2)
548	vn(:,:,:) = zweighm1 * vdta(:,:,:,1) + zweigh * vdta(:,:,:,2)
549	wn(:,:,:) = zweighm1 * wdta(:,:,:,1) + zweigh * wdta(:,:,:,2)
550	#if defined key_zdfddm
551	avs(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
552	#endif
553	avt(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
554	tn(:,:,:) = zweighm1 * tdta(:,:,:,1) + zweigh * tdta(:,:,:,2)
555	sn(:,:,:) = zweighm1 * sdta(:,:,:,1) + zweigh * sdta(:,:,:,2)
556
557
558	#if defined key_ldfslp
559	uslp(:,:,:) = zweighm1 * uslpdta(:,:,:,1) + zweigh * uslpdta(:,:,:,2)
560	vslp(:,:,:) = zweighm1 * vslpdta(:,:,:,1) + zweigh * vslpdta(:,:,:,2)
561	wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + zweigh * wslpidta(:,:,:,2)
562	wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + zweigh * wslpjdta(:,:,:,2)
563	#endif
564	flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2)
565	hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh * zmxldta(:,:,2)
566
567	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
568	bblx(:,:)= zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2)
569	bbly(:,:)= zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2)
570	#endif
571
572	!
573	! keep needed fluxes
574	!
575	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily
576	vatm(:,:) = flx(:,:,jpwind)
577	#endif
578	freeze(:,:) = flx(:,:,jpice)
579	emp(:,:) = flx(:,:,jpemp)
580	qsr(:,:) = flx(:,:,jpqsr)
581	!
582	! other interpolation
583	!
584	ELSE
585
586	WRITE (numout,*) ' this kind of interpolation don t EXIST'
587	WRITE (numout,*) ' at the moment. we STOP '
588	STOP 'dtadyn'
589
590	END IF
591
592	END IF
593	!
594	! lb in any case, we need rhop
595	!
596	CALL eos( tn, sn, rhd, rhop )
597
598	END SUBROUTINE dta_dyn
599
600	SUBROUTINE dynrea( kt, kenr )
601	!!----------------------------------------------------------------------
602	!! * ROUTINE dynrea *
603	!!
604	!! ** Purpose : READ dynamics fiels from OPA9 netcdf output
605	!!
606	!! ** Method : READ the kenr records of DATA and store in
607	!! in udta(...,2), ....
608	!!
609	!! ** History : additions : M. Levy et M. Benjelloul jan 2001
610	!! (netcdf FORMAT)
611	!! 05-03 (O. Aumont and A. El Moussaoui) F90
612	!!----------------------------------------------------------------------
613	!! * Modules used
614	USE ioipsl
615
616	!! * Arguments
617	INTEGER, INTENT( in ) :: kt, kenr ! time index
618	!! * Local declarations
619	INTEGER :: ji, jj
620	INTEGER :: ipi,ipj,ipk,itime,jkenr,idtatot
621	INTEGER , DIMENSION(ndtatot) :: istep
622
623	REAL(wp) :: zdate0, zdt
624
625	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
626	zu, zv, zw, zt, zs, zavt ! 3-D dynamical fields
627
628	REAL(wp), DIMENSION(jpi,jpj) :: &
629	zlon, zlat, zemp, zqsr, zmld, zice, zwind
630	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
631	REAL(wp), DIMENSION(jpi,jpj) :: &
632	zbblx, zbbly
633	#endif
634
635	REAL(wp), DIMENSION(jpk) :: zlev
636
637	CHARACTER(len=45) :: &
638	clname_t = 'dyna_grid_T.nc', &
639	clname_u = 'dyna_grid_U.nc', &
640	clname_v = 'dyna_grid_V.nc', &
641	clname_w = 'dyna_grid_W.nc', &
642	clname_s = 'dyna_wspd.nc'
643	!
644	! 0. Initialization
645	! cas d'un fichier non periodique : on utilise deux fois le premier et
646	! le dernier champ temporel
647
648
649	jkenr = kenr
650
651	IF(lwp) THEN
652	WRITE(numout,*)
653	WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr
654	WRITE(numout,*) ' ~~~~~~~'
655	WRITE(numout,*)
656	ENDIF
657
658
659
660	idtatot = ndtatot
661
662	IF( kt == nit000 .AND. nlecoff == 0 ) THEN
663
664	nlecoff = 1
665
666	CALL flinopen(clname_t,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
667	& ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_t)
668
669	IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
670	IF(lwp) THEN
671	WRITE(numout,*)
672	WRITE(numout,*) 'problem with dimensions'
673	WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
674	WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
675	WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
676	ENDIF
677	STOP 'dynrea '
678	ENDIF
679
680	CALL flinopen(clname_u,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
681	& ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_u)
682
683	IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
684	IF(lwp) THEN
685	WRITE(numout,*)
686	WRITE(numout,*) 'problem with dimensions'
687	WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
688	WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
689	WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
690	ENDIF
691	STOP 'dynrea '
692	ENDIF
693
694	CALL flinopen(clname_v,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
695	& ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_v)
696
697	IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
698	IF(lwp) THEN
699	WRITE(numout,*)
700	WRITE(numout,*) 'problem with dimensions'
701	WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
702	WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
703	WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
704	ENDIF
705	STOP 'dynrea '
706	ENDIF
707
708	CALL flinopen(clname_w,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
709	& ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_w)
710
711	IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
712	IF(lwp) THEN
713	WRITE(numout,*)
714	WRITE(numout,*) 'problem with dimensions'
715	WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
716	WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
717	WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
718	ENDIF
719	STOP 'dynrea '
720	ENDIF
721
722	CALL flinopen(clname_s,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
723	& ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_s)
724
725	IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN
726	IF(lwp) THEN
727	WRITE(numout,*)
728	WRITE(numout,*) 'problem with dimensions'
729	WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
730	WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
731	ENDIF
732	STOP 'dynrea'
733	ENDIF
734
735	ENDIF
736
737	CALL flinget(numfl_u,'vozocrtx',jpidta,jpjdta,jpk,idtatot,jkenr, &
738	& jkenr,mig(1),nlci,mjg(1),nlcj,zu(1:nlci,1:nlcj,1:jpk))
739
740	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
741	CALL flinget(numfl_u,'sobblcox',jpidta,jpjdta,1,idtatot,jkenr, &
742	& jkenr,mig(1),nlci,mjg(1),nlcj,zbblx(1:nlci,1:nlcj))
743	#endif
744
745
746	CALL flinget(numfl_v,'vomecrty',jpidta,jpjdta,jpk,idtatot,jkenr, &
747	& jkenr,mig(1),nlci,mjg(1),nlcj,zv(1:nlci,1:nlcj,1:jpk))
748
749	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
750	CALL flinget(numfl_v,'sobblcoy',jpidta,jpjdta,1,idtatot,jkenr, &
751	& jkenr,mig(1),nlci,mjg(1),nlcj,zbbly(1:nlci,1:nlcj))
752	#endif
753
754	CALL flinget(numfl_w,'vovecrtz',jpidta,jpjdta,jpk,idtatot,jkenr, &
755	& jkenr,mig(1),nlci,mjg(1),nlcj,zw(1:nlci,1:nlcj,1:jpk))
756
757
758	#if defined key_zdfddm
759	CALL flinget(numfl_w,'voddmavs',jpidta,jpjdta,jpk,idtatot,jkenr, &
760	& jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk))
761	#else
762	CALL flinget(numfl_w,'votkeavt',jpidta,jpjdta,jpk,idtatot,jkenr, &
763	& jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk))
764	#endif
765
766	CALL flinget(numfl_t,'votemper',jpidta,jpjdta,jpk,idtatot,jkenr, &
767	& jkenr,mig(1),nlci,mjg(1),nlcj,zt(1:nlci,1:nlcj,1:jpk))
768
769	CALL flinget(numfl_t,'vosaline',jpidta,jpjdta,jpk,idtatot,jkenr, &
770	& jkenr,mig(1),nlci,mjg(1),nlcj,zs(1:nlci,1:nlcj,1:jpk))
771
772	CALL flinget(numfl_t,'somixhgt',jpidta,jpjdta,1,idtatot,jkenr, &
773	& jkenr,mig(1),nlci,mjg(1),nlcj,zmld(1:nlci,1:nlcj))
774
775	CALL flinget(numfl_t,'sowaflup',jpidta,jpjdta,1,idtatot,jkenr, &
776	& jkenr,mig(1),nlci,mjg(1),nlcj,zemp(1:nlci,1:nlcj))
777
778	CALL flinget(numfl_t,'soshfldo',jpidta,jpjdta,1,idtatot,jkenr, &
779	& jkenr,mig(1),nlci,mjg(1),nlcj,zqsr(1:nlci,1:nlcj))
780
781	CALL flinget(numfl_t,'soicecov',jpidta,jpjdta,1,idtatot,jkenr, &
782	& jkenr,mig(1),nlci,mjg(1),nlcj,zice(1:nlci,1:nlcj))
783
784	CALL flinget(numfl_s,'wspd', jpidta,jpjdta,1,idtatot,jkenr, &
785	& jkenr,mig(1),nlci,mjg(1),nlcj,zwind(1:nlci,1:nlcj))
786
787
788	! Extra-halo initialization in MPP
789	IF( lk_mpp ) THEN
790	DO ji = nlci+1, jpi
791	zu(ji,:,:) = zu(1,:,:)
792	zv(ji,:,:) = zv(1,:,:)
793	zw(ji,:,:) = zw(1,:,:)
794	zavt(ji,:,:)=zavt(1,:,:)
795	zt(ji,:,:)=zt(1,:,:)
796	zs(ji,:,:)=zs(1,:,:)
797	zmld(ji,:)=zmld(1,:)
798	zwind(ji,:)=zwind(1,:)
799	zemp(ji,:)=zemp(1,:)
800	zqsr(ji,:)=zqsr(1,:)
801	zice(ji,:)=zice(1,:)
802	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
803	zbblx(ji,:)=zbblx(1,:)
804	zbbly(ji,:)=zbbly(1,:)
805	#endif
806
807	ENDDO
808	DO jj = nlcj+1, jpj
809	zu(:,jj,:) = zu(:,1,:)
810	zv(:,jj,:) = zv(:,1,:)
811	zw(:,jj,:) = zw(:,1,:)
812	zavt(:,jj,:)=zavt(:,1,:)
813	zt(:,jj,:)=zt(:,1,:)
814	zs(:,jj,:)=zs(:,1,:)
815	zmld(:,jj)=zmld(:,1)
816	zwind(:,jj)=zwind(:,1)
817	zemp(:,jj)=zemp(:,1)
818	zqsr(:,jj)=zqsr(:,1)
819	zice(:,jj)=zice(:,1)
820	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
821	zbblx(:,jj)=zbblx(:,1)
822	zbbly(:,jj)=zbbly(:,1)
823	#endif
824
825	ENDDO
826	ENDIF
827
828
829	udta(:,:,:,2)=zu(:,:,:)*umask(:,:,:)
830	vdta(:,:,:,2)=zv(:,:,:)*vmask(:,:,:)
831	wdta(:,:,:,2)=zw(:,:,:)*tmask(:,:,:)
832	tdta(:,:,:,2)=zt(:,:,:)*tmask(:,:,:)
833	sdta(:,:,:,2)=zs(:,:,:)*tmask(:,:,:)
834	avtdta(:,:,:,2)=zavt(:,:,:)*tmask(:,:,:)
835	!
836	!
837	! flux :
838	!
839	flxdta(:,:,jpwind,2)=zwind(:,:)*tmask(:,:,1)
840	flxdta(:,:,jpice,2)=min(1.,zice(:,:))*tmask(:,:,1)
841	flxdta(:,:,jpemp,2)=zemp(:,:)*tmask(:,:,1)
842	flxdta(:,:,jpqsr,2)=zqsr(:,:)*tmask(:,:,1)
843	zmxldta(:,:,2)=zmld(:,:)*tmask(:,:,1)
844
845	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
846	bblxdta(:,:,2)=max(0.,zbblx(:,:))
847	bblydta(:,:,2)=max(0.,zbbly(:,:))
848
849	DO ji=1,jpi
850	DO jj=1,jpj
851	if (bblxdta(ji,jj,2).gt.2.) bblxdta(ji,jj,2)=0.
852	if (bblydta(ji,jj,2).gt.2.) bblydta(ji,jj,2)=0.
853	END DO
854	END DO
855	#endif
856
857	END SUBROUTINE dynrea
858
859
860
861	END MODULE dtadyn

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

Download in other formats: