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 tags/nemo_v1_12/NEMO/OFF_SRC – NEMO

Context Navigation

source: tags/nemo_v1_12/NEMO/OFF_SRC/dtadyn.F90 @ 3319

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

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

Download in other formats: