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 @ 1013

Last change on this file since 1013 was 1013, checked in by cetlod, 16 years ago
adding wind speed module variable, see ticket 172
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 30.6 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 sbc_oce
18	USE ldfslp
19	USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)
20	USE ldftra_oce ! ocean tracer lateral physics
21	USE zdfmxl
22	USE trabbl ! tracers: bottom boundary layer
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 = 7
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 wind speed
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 :: &
56	ndyn1, ndyn2 , &
57	nlecoff = 0 , & ! switch for the first read
58	numfl_t, numfl_u, &
59	numfl_v, numfl_w
60
61
62	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
63	tdta , & ! temperature at two consecutive times
64	sdta , & ! salinity at two consecutive times
65	udta , & ! zonal velocity at two consecutive times
66	vdta , & ! meridional velocity at two consecutive times
67	wdta , & ! vertical velocity at two consecutive times
68	#if defined key_trc_diatrd
69	hdivdta, & ! horizontal divergence
70	#endif
71	avtdta ! vertical diffusivity coefficient
72
73
74	#if defined key_ldfslp
75	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
76	uslpdta , & ! zonal isopycnal slopes
77	vslpdta , & ! meridional isopycnal slopes
78	wslpidta , & ! zonal diapycnal slopes
79	wslpjdta ! meridional diapycnal slopes
80	#endif
81
82	#if ! defined key_off_degrad
83
84	# if defined key_traldf_c2d
85	REAL(wp), DIMENSION(jpi,jpj,2) :: &
86	ahtwdta ! Lateral diffusivity
87	# if defined key_trcldf_eiv
88	REAL(wp), DIMENSION(jpi,jpj,2) :: &
89	aeiwdta ! G&M coefficient
90	# endif
91	# endif
92
93	#else
94
95	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
96	ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity
97	# if defined key_trcldf_eiv
98	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
99	aeiudta, aeivdta, aeiwdta ! G&M coefficient
100	# endif
101
102	#endif
103	# if defined key_diaeiv
104	!! GM Velocity : to be used latter
105	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
106	eivudta, eivvdta, eivwdta
107	# endif
108
109	REAL(wp), DIMENSION(jpi,jpj,jpflx,2) :: &
110	flxdta ! auxiliary 2-D forcing fields at two consecutive times
111	REAL(wp), DIMENSION(jpi,jpj,2) :: &
112	zmxldta ! mixed layer depth at two consecutive times
113
114	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
115	REAL(wp), DIMENSION(jpi,jpj,2) :: &
116	bblxdta , & ! frequency of bbl in the x direction at 2 consecutive times
117	bblydta ! frequency of bbl in the y direction at 2 consecutive times
118	#endif
119
120	!! * Substitutions
121	# include "domzgr_substitute.h90"
122	# include "vectopt_loop_substitute.h90"
123	!!----------------------------------------------------------------------
124	!! OPA 9.0 , LOCEAN-IPSL (2005)
125	!! $Header: /home/opalod/NEMOCVSROOT/NEMO/OFF_SRC/dtadyn.F90,v 1.8 2007/10/12 09:05:29 opalod Exp $
126	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
127	!!----------------------------------------------------------------------
128
129	CONTAINS
130
131	SUBROUTINE dta_dyn_init
132	!!----------------------------------------------------------------------
133	!! * ROUTINE dta_dyn_init *
134	!!
135	!! ** Purpose : initializations of parameters for the interpolation
136	!!
137	!! ** Method :
138	!!
139	!! History :
140	!! ! original : 92-01 (M. Imbard: sub domain)
141	!! ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
142	!! ! 98-05 (L. Bopp read output of coupled run)
143	!! ! 05-03 (O. Aumont and A. El Moussaoui) F90
144	!!----------------------------------------------------------------------
145	!! * Modules used
146
147	!! * Local declarations
148
149
150	NAMELIST/nam_offdyn/ ndtadyn, ndtatot, nsptint, &
151	& nficdyn, lperdyn
152	!!----------------------------------------------------------------------
153
154	! Define the dynamical input parameters
155	! ======================================
156
157	! Read Namelist nam_offdyn : Lateral physics on tracers
158	REWIND( numnam )
159	READ ( numnam, nam_offdyn )
160
161	IF(lwp) THEN
162	WRITE(numout,*)
163	WRITE(numout,*) 'nam_offdyn : offline dynamical selection'
164	WRITE(numout,*) '~~~~~~~'
165	WRITE(numout,*) ' Namelist nam_offdyn : set parameters for the lecture of the dynamical fields'
166	WRITE(numout,*)
167	WRITE(numout,*) ' number of elements in the FILE for a year ndtadyn = ' , ndtadyn
168	WRITE(numout,*) ' total number of elements in the FILE ndtatot = ' , ndtatot
169	WRITE(numout,*) ' type of interpolation nsptint = ' , nsptint
170	WRITE(numout,*) ' number of dynamics FILE nficdyn = ' , nficdyn
171	WRITE(numout,*) ' loop on the same FILE lperdyn = ' , lperdyn
172	WRITE(numout,*) ' '
173	ENDIF
174
175	END SUBROUTINE dta_dyn_init
176
177	SUBROUTINE dta_dyn(kt)
178	!!----------------------------------------------------------------------
179	!! * ROUTINE dta_dyn *
180	!!
181	!! ** Purpose : Prepares dynamics and physics fields from an
182	!! OPA9 simulation for an off-line simulation
183	!! for passive tracer
184	!!
185	!! ** Method : calculates the position of DATA to read READ DATA
186	!! (example month changement) computes slopes IF needed
187	!! interpolates DATA IF needed
188	!!
189	!! ** History :
190	!! ! original : 92-01 (M. Imbard: sub domain)
191	!! ! addition : 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
192	!! ! addition : 98-05 (L. Bopp read output of coupled run)
193	!! ! addition : 05-03 (O. Aumont and A. El Moussaoui) F90
194	!! ! addition : 05-12 (C. Ethe) Adapted for DEGINT
195	!!----------------------------------------------------------------------
196	!! * Modules used
197	USE eosbn2
198
199	!! * Arguments
200	INTEGER, INTENT( in ) :: kt ! ocean time-step index
201
202	!! * Local declarations
203	INTEGER :: iper, iperm1, iswap
204
205	REAL(wp) :: zpdtan, zpdtpe, zdemi, zt
206	REAL(wp) :: zweigh, zweighm1
207
208	REAL(wp), DIMENSION(jpi,jpj,jpflx) :: &
209	flx ! auxiliary field for 2-D surface boundary conditions
210
211
212	! 0. Initialization
213	! -----------------
214
215	IF (lfirdyn) THEN
216	!
217	! time step MUST BE nint000
218	!
219	IF (kt.ne.nit000) THEN
220	IF (lwp) THEN
221	WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt=',kt &
222	,' nit000=',nit000
223	END IF
224	STOP 'dtadyn'
225	END if
226	! Initialize the parameters of the interpolation
227	CALL dta_dyn_init
228	ENDIF
229
230
231	zpdtan = raass / rdt
232	zpdtpe = ((zpdtan / FLOAT (ndtadyn)))
233	zdemi = zpdtpe * 0.5
234	zt = (FLOAT (kt) + zdemi ) / zpdtpe
235
236	zweigh = zt - FLOAT(INT(zt))
237	zweighm1 = 1. - zweigh
238
239	IF (lperdyn) THEN
240	iperm1 = MOD(INT(zt),ndtadyn)
241	ELSE
242	iperm1 = MOD(INT(zt),(ndtatot-1)) + 1
243	ENDIF
244	iper = iperm1 + 1
245	IF (iperm1 == 0) THEN
246	IF (lperdyn) THEN
247	iperm1 = ndtadyn
248	ELSE
249	IF (lfirdyn) THEN
250	IF (lwp) THEN
251	WRITE (numout,*) ' dynamic file is not periodic '
252	WRITE (numout,*) ' with or without interpolation, '
253	WRITE (numout,*) ' we take the first value'
254	WRITE (numout,*) ' for the previous period '
255	WRITE (numout,*) ' iperm1 = 0 '
256	END IF
257	END IF
258	END IF
259	END IF
260
261	iswap = 0
262
263	! 1. First call lfirdyn = true
264	! ----------------------------
265
266	IF (lfirdyn) THEN
267	!
268	! store the information of the period read
269	!
270	ndyn1 = iperm1
271	ndyn2 = iper
272
273	IF (lwp) THEN
274	WRITE (numout,*) &
275	' dynamics DATA READ for the period ndyn1 =',ndyn1, &
276	& ' and for the period ndyn2 = ',ndyn2
277	WRITE (numout,*) ' time step is :',kt
278	WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,&
279	& ' records in the dynamic FILE for one year'
280	END IF
281	!
282	! DATA READ for the iperm1 period
283	!
284	IF( iperm1 /= 0 ) THEN
285	CALL dynrea( kt, iperm1 )
286	ELSE
287	CALL dynrea( kt, 1 )
288	ENDIF
289	!
290	! Computes dynamical fields
291	!
292	tn(:,:,:)=tdta(:,:,:,2)
293	sn(:,:,:)=sdta(:,:,:,2)
294	avt(:,:,:)=avtdta(:,:,:,2)
295
296
297	IF(lwp) THEN
298	WRITE(numout,*)' temperature '
299	WRITE(numout,*)
300	CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
301	WRITE(numout,*) ' level = ',jpk/2
302	CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
303	WRITE(numout,*) ' level = ',jpkm1
304	CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
305	ENDIF
306
307	#if defined key_ldfslp
308	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
309	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
310	CALL zdf_mxl( kt ) ! mixed layer depth
311	CALL ldf_slp( kt, rhd, rn2 )
312
313	uslpdta(:,:,:,2)=uslp(:,:,:)
314	vslpdta(:,:,:,2)=vslp(:,:,:)
315	wslpidta(:,:,:,2)=wslpi(:,:,:)
316	wslpjdta(:,:,:,2)=wslpj(:,:,:)
317	#endif
318	!
319	! swap from record 2 to 1
320	!
321	udta(:,:,:,1)=udta(:,:,:,2)
322	vdta(:,:,:,1)=vdta(:,:,:,2)
323	wdta(:,:,:,1)=wdta(:,:,:,2)
324	#if defined key_trc_diatrd
325	hdivdta(:,:,:,1)=hdivdta(:,:,:,2)
326	#endif
327	avtdta(:,:,:,1)=avtdta(:,:,:,2)
328	tdta(:,:,:,1)=tdta(:,:,:,2)
329	sdta(:,:,:,1)=sdta(:,:,:,2)
330	#if defined key_ldfslp
331	uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
332	vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
333	wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
334	wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
335	#endif
336	flxdta(:,:,:,1) = flxdta(:,:,:,2)
337	zmxldta(:,:,1)=zmxldta(:,:,2)
338	#if ! defined key_off_degrad
339
340	# if defined key_traldf_c2d
341	ahtwdta(:,:,1)= ahtwdta(:,:,2)
342	# if defined key_trcldf_eiv
343	aeiwdta(:,:,1)= aeiwdta(:,:,2)
344	# endif
345	# endif
346
347	#else
348	ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
349	ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
350	ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
351	# if defined key_trcldf_eiv
352	aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
353	aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
354	aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
355	# endif
356
357	#endif
358
359	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
360	bblxdta(:,:,1)=bblxdta(:,:,2)
361	bblydta(:,:,1)=bblydta(:,:,2)
362	#endif
363	!
364	! indicates a swap
365	!
366	iswap = 1
367	!
368	! DATA READ for the iper period
369	!
370	CALL dynrea( kt, iper )
371	!
372	! Computes wdta (and slopes if key_trahdfiso)
373	!
374	tn(:,:,:)=tdta(:,:,:,2)
375	sn(:,:,:)=sdta(:,:,:,2)
376	avt(:,:,:)=avtdta(:,:,:,2)
377
378
379	#if defined key_ldfslp
380	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
381	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
382	CALL zdf_mxl( kt ) ! mixed layer depth
383	CALL ldf_slp( kt, rhd, rn2 )
384
385	uslpdta(:,:,:,2)=uslp(:,:,:)
386	vslpdta(:,:,:,2)=vslp(:,:,:)
387	wslpidta(:,:,:,2)=wslpi(:,:,:)
388	wslpjdta(:,:,:,2)=wslpj(:,:,:)
389	#endif
390	!
391	! trace the first CALL
392	!
393	lfirdyn=.FALSE.
394	ENDIF
395	!
396	! and now what we have to DO at every time step
397	!
398	! check the validity of the period in memory
399	!
400	IF (iperm1.NE.ndyn1) THEN
401	IF (iperm1.EQ.0.) THEN
402	IF (lwp) THEN
403	WRITE (numout,*) ' dynamic file is not periodic '
404	WRITE (numout,*) ' with or without interpolation, '
405	WRITE (numout,*) ' we take the last value'
406	WRITE (numout,*) ' for the last period '
407	WRITE (numout,*) ' iperm1 = 12 '
408	WRITE (numout,*) ' iper = 13'
409	ENDIF
410	iperm1 = 12
411	iper =13
412	ENDIF
413	!
414	! we have to prepare a NEW READ of DATA
415	!
416	! swap from record 2 to 1
417	!
418	udta(:,:,:,1) = udta(:,:,:,2)
419	vdta(:,:,:,1) = vdta(:,:,:,2)
420	wdta(:,:,:,1) = wdta(:,:,:,2)
421	#if defined key_trc_diatrd
422	hdivdta(:,:,:,1)=hdivdta(:,:,:,2)
423	#endif
424	avtdta(:,:,:,1) = avtdta(:,:,:,2)
425	tdta(:,:,:,1) = tdta(:,:,:,2)
426	sdta(:,:,:,1) = sdta(:,:,:,2)
427	#if defined key_ldfslp
428	uslpdta(:,:,:,1) = uslpdta(:,:,:,2)
429	vslpdta(:,:,:,1) = vslpdta(:,:,:,2)
430	wslpidta(:,:,:,1) = wslpidta(:,:,:,2)
431	wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2)
432	#endif
433	flxdta(:,:,:,1) = flxdta(:,:,:,2)
434	zmxldta(:,:,1) = zmxldta(:,:,2)
435
436	#if ! defined key_off_degrad
437
438	# if defined key_traldf_c2d
439	ahtwdta(:,:,1)= ahtwdta(:,:,2)
440	# if defined key_trcldf_eiv
441	aeiwdta(:,:,1)= aeiwdta(:,:,2)
442	# endif
443	# endif
444
445	#else
446	ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
447	ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
448	ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
449	# if defined key_trcldf_eiv
450	aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
451	aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
452	aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
453	# endif
454
455	#endif
456
457	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
458	bblxdta(:,:,1) = bblxdta(:,:,2)
459	bblydta(:,:,1) = bblydta(:,:,2)
460	#endif
461	!
462	! indicates a swap
463	!
464	iswap = 1
465	!
466	! READ DATA for the iper period
467	!
468	CALL dynrea( kt, iper )
469	!
470	! Computes wdta (and slopes if key_trahdfiso)
471	!
472	tn(:,:,:)=tdta(:,:,:,2)
473	sn(:,:,:)=sdta(:,:,:,2)
474	avt(:,:,:)=avtdta(:,:,:,2)
475
476	#if defined key_ldfslp
477	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
478	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
479	CALL zdf_mxl( kt ) ! mixed layer depth
480	CALL ldf_slp( kt, rhd, rn2 )
481
482	uslpdta(:,:,:,2)=uslp(:,:,:)
483	vslpdta(:,:,:,2)=vslp(:,:,:)
484	wslpidta(:,:,:,2)=wslpi(:,:,:)
485	wslpjdta(:,:,:,2)=wslpj(:,:,:)
486	#endif
487	!
488	! store the information of the period read
489	!
490	ndyn1 = ndyn2
491	ndyn2 = iper
492	!
493	! we have READ another period of DATA !
494	IF (lwp) THEN
495	WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1
496	WRITE (numout,*) ' and the period ndyn2 = ',ndyn2
497	WRITE (numout,*) ' time step is :',kt
498	END IF
499
500	END IF
501
502	!
503	! compute the DATA at the given time step
504	!
505	IF ( nsptint == 0 ) THEN
506	!
507	! no spatial interpolation
508	!
509	! DATA are probably correct
510	! we have to initialize DATA IF we have changed the period
511	!
512	IF (iswap.eq.1) THEN
513	!
514	! initialize now fields with the NEW DATA READ
515	!
516	un(:,:,:)=udta(:,:,:,2)
517	vn(:,:,:)=vdta(:,:,:,2)
518	wn(:,:,:)=wdta(:,:,:,2)
519	#if defined key_trc_diatrd
520	hdivn(:,:,:)=hdivdta(:,:,:,2)
521	#endif
522	#if defined key_trc_zdfddm
523	avs(:,:,:)=avtdta(:,:,:,2)
524	#endif
525	avt(:,:,:)=avtdta(:,:,:,2)
526	tn(:,:,:)=tdta(:,:,:,2)
527	sn(:,:,:)=sdta(:,:,:,2)
528	#if defined key_ldfslp
529	uslp(:,:,:)=uslpdta(:,:,:,2)
530	vslp(:,:,:)=vslpdta(:,:,:,2)
531	wslpi(:,:,:)=wslpidta(:,:,:,2)
532	wslpj(:,:,:)=wslpjdta(:,:,:,2)
533	#endif
534	flx(:,:,:) = flxdta(:,:,:,2)
535	hmld(:,:)=zmxldta(:,:,2)
536	#if ! defined key_off_degrad
537
538	# if defined key_traldf_c2d
539	ahtwdta(:,:,1)= ahtwdta(:,:,2)
540	# if defined key_trcldf_eiv
541	aeiwdta(:,:,1)= aeiwdta(:,:,2)
542	# endif
543	# endif
544
545	#else
546	ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
547	ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
548	ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
549	# if defined key_trcldf_eiv
550	aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
551	aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
552	aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
553	# endif
554
555	#endif
556
557	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
558	bblx(:,:)=bblxdta(:,:,2)
559	bbly(:,:)=bblydta(:,:,2)
560	#endif
561	!
562	! keep needed fluxes
563	!
564	wndm(:,:) = flx(:,:,jpwind)
565	freeze(:,:) = flx(:,:,jpice)
566	emp(:,:) = flx(:,:,jpemp)
567	emps(:,:) = emp(:,:)
568	qsr(:,:) = flx(:,:,jpqsr)
569
570	END IF
571
572	ELSE
573	IF ( nsptint == 1 ) THEN
574	!
575	! linear interpolation
576	!
577	! initialize now fields with a linear interpolation
578	!
579	un(:,:,:) = zweighm1 * udta(:,:,:,1) + zweigh * udta(:,:,:,2)
580	vn(:,:,:) = zweighm1 * vdta(:,:,:,1) + zweigh * vdta(:,:,:,2)
581	wn(:,:,:) = zweighm1 * wdta(:,:,:,1) + zweigh * wdta(:,:,:,2)
582	#if defined key_trc_diatrd
583	hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + zweigh * hdivdta(:,:,:,2)
584	#endif
585	#if defined key_zdfddm
586	avs(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
587	#endif
588	avt(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
589	tn(:,:,:) = zweighm1 * tdta(:,:,:,1) + zweigh * tdta(:,:,:,2)
590	sn(:,:,:) = zweighm1 * sdta(:,:,:,1) + zweigh * sdta(:,:,:,2)
591
592
593	#if defined key_ldfslp
594	uslp(:,:,:) = zweighm1 * uslpdta(:,:,:,1) + zweigh * uslpdta(:,:,:,2)
595	vslp(:,:,:) = zweighm1 * vslpdta(:,:,:,1) + zweigh * vslpdta(:,:,:,2)
596	wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + zweigh * wslpidta(:,:,:,2)
597	wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + zweigh * wslpjdta(:,:,:,2)
598	#endif
599	flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2)
600	hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh * zmxldta(:,:,2)
601	#if ! defined key_off_degrad
602
603	# if defined key_traldf_c2d
604	ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2)
605	# if defined key_trcldf_eiv
606	aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + zweigh * aeiwdta(:,:,2)
607	# endif
608	# endif
609
610	#else
611	ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + zweigh * ahtudta(:,:,:,2)
612	ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + zweigh * ahtvdta(:,:,:,2)
613	ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + zweigh * ahtwdta(:,:,:,2)
614	# if defined key_trcldf_eiv
615	aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + zweigh * aeiudta(:,:,:,2)
616	aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + zweigh * aeivdta(:,:,:,2)
617	aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + zweigh * aeiwdta(:,:,:,2)
618	# endif
619
620	#endif
621
622	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
623	bblx(:,:) = zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2)
624	bbly(:,:) = zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2)
625	#endif
626	!
627	! keep needed fluxes
628	!
629	wndm(:,:) = flx(:,:,jpwind)
630	freeze(:,:) = flx(:,:,jpice)
631	emp(:,:) = flx(:,:,jpemp)
632	emps(:,:) = emp(:,:)
633	qsr(:,:) = flx(:,:,jpqsr)
634	!
635	! other interpolation
636	!
637	ELSE
638
639	WRITE (numout,*) ' this kind of interpolation don t EXIST'
640	WRITE (numout,*) ' at the moment. we STOP '
641	STOP 'dtadyn'
642
643	END IF
644
645	END IF
646	!
647	! lb in any case, we need rhop
648	!
649	CALL eos( tn, sn, rhd, rhop )
650
651	#if ! defined key_off_degrad && defined key_traldf_c2d
652	! In case of 2D varying coefficients, we need aeiv and aeiu
653	IF( lk_traldf_eiv ) CALL ldf_eiv( kt ) ! eddy induced velocity coefficient
654	#endif
655
656	END SUBROUTINE dta_dyn
657
658	SUBROUTINE dynrea( kt, kenr )
659	!!----------------------------------------------------------------------
660	!! * ROUTINE dynrea *
661	!!
662	!! ** Purpose : READ dynamics fiels from OPA9 netcdf output
663	!!
664	!! ** Method : READ the kenr records of DATA and store in
665	!! in udta(...,2), ....
666	!!
667	!! ** History : additions : M. Levy et M. Benjelloul jan 2001
668	!! (netcdf FORMAT)
669	!! 05-03 (O. Aumont and A. El Moussaoui) F90
670	!! 06-07 : (C. Ethe) use of iom module
671	!!----------------------------------------------------------------------
672	!! * Modules used
673	USE iom
674
675	!! * Arguments
676	INTEGER, INTENT( in ) :: kt, kenr ! time index
677	!! * Local declarations
678	INTEGER :: ji, jj, jk, jkenr
679
680	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
681	zu, zv, zw, zt, zs, zavt , & ! 3-D dynamical fields
682	zhdiv ! horizontal divergence
683
684	REAL(wp), DIMENSION(jpi,jpj) :: &
685	zemp, zqsr, zmld, zice, zwspd
686	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
687	REAL(wp), DIMENSION(jpi,jpj) :: &
688	zbblx, zbbly
689	#endif
690
691	#if ! defined key_off_degrad
692
693	# if defined key_traldf_c2d
694	REAL(wp), DIMENSION(jpi,jpj) :: &
695	zahtw
696	# if defined key_trcldf_eiv
697	REAL(wp), DIMENSION(jpi,jpj) :: &
698	zaeiw
699	# endif
700	# endif
701
702	#else
703
704	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
705	zahtu, zahtv, zahtw ! Lateral diffusivity
706	# if defined key_trcldf_eiv
707	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
708	zaeiu, zaeiv, zaeiw ! G&M coefficient
709	# endif
710
711	#endif
712
713	# if defined key_diaeiv
714	!! GM Velocity : to be used latter
715	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
716	zeivu, zeivv, zeivw
717	# endif
718
719	CHARACTER(len=45) :: &
720	clname_t = 'dyna_grid_T.nc', &
721	clname_u = 'dyna_grid_U.nc', &
722	clname_v = 'dyna_grid_V.nc', &
723	clname_w = 'dyna_grid_W.nc'
724	!
725	! 0. Initialization
726	! cas d'un fichier non periodique : on utilise deux fois le premier et
727	! le dernier champ temporel
728
729	jkenr = kenr
730
731	IF(lwp) THEN
732	WRITE(numout,*)
733	WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr
734	WRITE(numout,*) ' ~~~~~~~'
735	#if defined key_off_degrad
736	WRITE(numout,*) ' Degraded fields'
737	#endif
738	WRITE(numout,*)
739	ENDIF
740
741
742	IF( kt == nit000 .AND. nlecoff == 0 ) THEN
743
744	nlecoff = 1
745
746	CALL iom_open ( clname_t, numfl_t )
747	CALL iom_open ( clname_u, numfl_u )
748	CALL iom_open ( clname_v, numfl_v )
749	CALL iom_open ( clname_w, numfl_w )
750
751	ENDIF
752
753	! file grid-T
754	!---------------
755	CALL iom_get ( numfl_t, jpdom_data, 'votemper', zt (:,:,:), jkenr )
756	CALL iom_get ( numfl_t, jpdom_data, 'vosaline', zs (:,:,:), jkenr )
757	CALL iom_get ( numfl_t, jpdom_data, 'somixhgt', zmld (:,: ), jkenr )
758	CALL iom_get ( numfl_t, jpdom_data, 'sowaflcd', zemp (:,: ), jkenr )
759	CALL iom_get ( numfl_t, jpdom_data, 'soshfldo', zqsr (:,: ), jkenr )
760	CALL iom_get ( numfl_t, jpdom_data, 'soicecov', zice (:,: ), jkenr )
761	CALL iom_get ( numfl_t, jpdom_data, 'sowindsp', zwspd(:,: ), jkenr )
762
763	! file grid-U
764	!---------------
765	CALL iom_get ( numfl_u, jpdom_data, 'vozocrtx', zu (:,:,:), jkenr )
766	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
767	CALL iom_get ( numfl_u, jpdom_data, 'sobblcox', zbblx(:,: ), jkenr )
768	#endif
769
770	#if defined key_diaeiv
771	!! GM Velocity : to be used latter
772	CALL iom_get ( numfl_u, jpdom_data, 'vozoeivu', zeivu(:,:,:), jkenr )
773	#endif
774
775	# if defined key_off_degrad
776	CALL iom_get ( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr )
777	# if defined key_trcldf_eiv
778	CALL iom_get ( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr )
779	# endif
780	#endif
781
782	! file grid-V
783	!---------------
784	CALL iom_get ( numfl_v, jpdom_data, 'vomecrty', zv (:,:,:), jkenr )
785	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
786	CALL iom_get ( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,: ), jkenr )
787	#endif
788
789	#if defined key_diaeiv
790	!! GM Velocity : to be used latter
791	CALL iom_get ( numfl_v, jpdom_data, 'vomeeivv', zeivv(:,:,:), jkenr )
792	#endif
793
794	#if defined key_off_degrad
795	CALL iom_get ( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr )
796	# if defined key_trcldf_eiv
797	CALL iom_get ( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr )
798	# endif
799	#endif
800
801	! file grid-W
802	!---------------
803	!! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr )
804	# if defined key_zdfddm
805	CALL iom_get ( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr )
806	#else
807	CALL iom_get ( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr )
808	#endif
809
810	# if defined key_diaeiv
811	!! GM Velocity : to be used latter
812	CALL iom_get ( numfl_w, jpdom_data, 'voveeivw', zeivw(:,:,:), jkenr )
813	#endif
814
815	#if ! defined key_off_degrad
816	# if defined key_traldf_c2d
817	CALL iom_get ( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr )
818	# if defined key_trcldf_eiv
819	CALL iom_get ( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr )
820	# endif
821	# endif
822	#else
823	!! degradation-integration
824	CALL iom_get ( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr )
825	# if defined key_trcldf_eiv
826	CALL iom_get ( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr )
827	# endif
828	#endif
829
830	udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:)
831	vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:)
832	!! wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
833
834
835	! Computation of vertical velocity using horizontal divergence
836	zhdiv(:,:,:) = 0.
837	DO jk = 1, jpkm1
838	DO jj = 2, jpjm1
839	DO ji = fs_2, fs_jpim1 ! vector opt.
840	#if defined key_zco
841	zhdiv(ji,jj,jk) = ( e2u(ji,jj) * udta(ji,jj,jk,2) - e2u(ji-1,jj ) * udta(ji-1,jj ,jk,2) &
842	& + e1v(ji,jj) * vdta(ji,jj,jk,2) - e1v(ji ,jj-1) * vdta(ji ,jj-1,jk,2) ) &
843	& / ( e1t(ji,jj) * e2t(ji,jj) )
844	#else
845	zhdiv(ji,jj,jk) = &
846	( e2u(ji,jj)fse3u(ji,jj,jk)udta(ji,jj,jk,2) - e2u(ji-1,jj)fse3u(ji-1,jj,jk)udta(ji-1,jj,jk,2) &
847	+ e1v(ji,jj)fse3v(ji,jj,jk)vdta(ji,jj,jk,2) - e1v(ji,jj-1)fse3v(ji,jj-1,jk)vdta(ji,jj-1,jk,2) ) &
848	/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
849	#endif
850	END DO
851	END DO
852	ENDDO
853
854	! Lateral boundary conditions on hdiv
855	CALL lbc_lnk( zhdiv, 'T', 1. )
856
857
858	! computation of vertical velocity from the bottom
859	zw(:,:,jpk) = 0.
860	DO jk = jpkm1, 1, -1
861	zw(:,:,jk) = zw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)
862	END DO
863
864	wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
865	#if defined key_trc_diatrd
866	hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:)
867	#endif
868
869	tdta(:,:,:,2) = zt(:,:,:) * tmask(:,:,:)
870	sdta(:,:,:,2) = zs(:,:,:) * tmask(:,:,:)
871	avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:)
872	#if ! defined key_off_degrad && defined key_traldf_c2d
873	ahtwdta(:,:,2) = zahtw(:,:) * tmask(:,:,1)
874	#if defined key_trcldf_eiv
875	aeiwdta(:,:,2) = zaeiw(:,:) * tmask(:,:,1)
876	#endif
877	#endif
878
879	#if defined key_off_degrad
880	ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:)
881	ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:)
882	ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:)
883	# if defined key_trcldf_eiv
884	aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:)
885	aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:)
886	aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:)
887	# endif
888	#endif
889
890	!
891	! flux :
892	!
893	flxdta(:,:,jpwind,2) = zwspd(:,:) * tmask(:,:,1)
894	flxdta(:,:,jpice,2) = MIN( 1., zice(:,:) ) * tmask(:,:,1)
895	flxdta(:,:,jpemp,2) = zemp(:,:) * tmask(:,:,1)
896	flxdta(:,:,jpqsr,2) = zqsr(:,:) * tmask(:,:,1)
897	zmxldta(:,:,2) = zmld(:,:) * tmask(:,:,1)
898
899	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
900	bblxdta(:,:,2) = MAX( 0., zbblx(:,:) )
901	bblydta(:,:,2) = MAX( 0., zbbly(:,:) )
902
903	WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0.
904	WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0.
905
906	#endif
907
908	IF( kt == nitend ) THEN
909	CALL iom_close ( numfl_t )
910	CALL iom_close ( numfl_u )
911	CALL iom_close ( numfl_v )
912	CALL iom_close ( numfl_w )
913	ENDIF
914
915	END SUBROUTINE dynrea
916
917
918
919	END MODULE dtadyn

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

Download in other formats: