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

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

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

Download in other formats: