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 branches/offline/NEMO/OFF_SRC – NEMO

Context Navigation

source: branches/offline/NEMO/OFF_SRC/dtadyn.F90 @ 786

Last change on this file since 786 was 325, checked in by opalod, 19 years ago
Initial revision
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 28.1 KB

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

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

Download in other formats: