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

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

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

Download in other formats: