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

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

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

Download in other formats: