Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

startvar.F @ 588

Last change on this file since 588 was 588, checked in by (none), 19 years ago
This commit was manufactured by cvs2svn to create branch 'IPSL-CM4_IPCC_branch'.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 39.7 KB

Line
1	!
2	! $Header$
3	!
4	C
5	C
6	MODULE startvar
7	!
8	!
9	! There are three ways to access data from the database of atmospheric data which
10	! can be used to initialize the model. This depends on the type of field which needs
11	! to be extracted. In any case the call should come after a restget and should be of the type :
12	! CALL startget(...)
13	!
14	! We will details the possible arguments to startget here :
15	!
16	! - A 2D variable on the dynamical grid :
17	! CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )
18	!
19	! - A 1D variable on the physical grid :
20	! CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
21	!
22	!
23	! - A 3D variable on the dynamical grid :
24	! CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
25	!
26	!
27	! There is special constraint on the atmospheric data base except that the
28	! the data needs to be in netCDF and the variables should have the the following
29	! names in the file :
30	!
31	! 'RELIEF' : High resolution orography
32	! 'ST' : Surface temperature
33	! 'CDSW' : Soil moisture
34	! 'Z' : Surface geopotential
35	! 'SP' : Surface pressure
36	! 'U' : East ward wind
37	! 'V' : Northward wind
38	! 'TEMP' : Temperature
39	! 'R' : Relative humidity
40	!
41	USE ioipsl
42	!
43	!
44	IMPLICIT NONE
45	!
46	!
47	PRIVATE
48	PUBLIC startget
49	!
50	!
51	INTERFACE startget
52	MODULE PROCEDURE startget_phys2d, startget_phys1d, startget_dyn
53	END INTERFACE
54	!
55	INTEGER, SAVE :: fid_phys, fid_dyn
56	INTEGER, SAVE :: iml_phys, iml_rel, iml_dyn
57	INTEGER, SAVE :: jml_phys, jml_rel, jml_dyn
58	INTEGER, SAVE :: llm_dyn, ttm_dyn
59	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lon_phys, lon_rug,
60	. lon_alb, lon_rel, lon_dyn
61	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lat_phys, lat_rug,
62	. lat_alb, lat_rel, lat_dyn
63	REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: levdyn_ini
64	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: relief, zstd, zsig,
65	. zgam, zthe, zpic, zval
66	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: rugo, masque, phis
67	!
68	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: tsol, qsol, psol_dyn
69	REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: var_ana3d
70	!
71	CONTAINS
72	!
73	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
74	!
75	SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in,
76	. champ, val_exp, jml2, lon_in2, lat_in2 , interbar, masque_lu )
77	!
78	! There is a big mess with the size in logitude, should it be iml or iml+1.
79	! I have chosen to use the iml+1 as an argument to this routine and we declare
80	! internaly smaler fields when needed. This needs to be cleared once and for all in LMDZ.
81	! A convention is required.
82	!
83	!
84	CHARACTER(), INTENT(in) :: varname
85	INTEGER, INTENT(in) :: iml, jml ,jml2
86	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
87	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
88	REAL, INTENT(inout) :: champ(iml,jml)
89	REAL, INTENT(in) :: val_exp
90	REAL, INTENT(in), optional :: masque_lu(iml,jml)
91	LOGICAL interbar
92	!
93	! This routine only works if the variable does not exist or is constant
94	!
95	IF ( MINVAL(champ(:,:)).EQ.MAXVAL(champ(:,:)) .AND.
96	.MINVAL(champ(:,:)).EQ.val_exp ) THEN
97	!
98	SELECTCASE(varname)
99	!
100	CASE ('relief')
101	!
102	! If we do not have the orography we need to get it
103	!
104	IF ( .NOT.ALLOCATED(relief)) THEN
105	!
106	if (present(masque_lu)) then
107	CALL start_init_orog( iml, jml, lon_in, lat_in,
108	. jml2,lon_in2,lat_in2, interbar, masque_lu )
109	else
110	CALL start_init_orog( iml, jml, lon_in, lat_in,
111	. jml2,lon_in2,lat_in2, interbar)
112	endif
113	!
114	ENDIF
115	!
116	IF (SIZE(relief) .NE. SIZE(champ)) THEN
117	!
118	WRITE(,) 'STARTVAR module has been',
119	.' initialized to the wrong size'
120	STOP
121	!
122	ENDIF
123	!
124	champ(:,:) = relief(:,:)
125	!
126	CASE ('rugosite')
127	!
128	! If we do not have the orography we need to get it
129	!
130	IF ( .NOT.ALLOCATED(rugo)) THEN
131	!
132	CALL start_init_orog( iml, jml, lon_in, lat_in,
133	. jml2,lon_in2,lat_in2 , interbar )
134	!
135	ENDIF
136	!
137	IF (SIZE(rugo) .NE. SIZE(champ)) THEN
138	!
139	WRITE(,)
140	. 'STARTVAR module has been initialized to the wrong size'
141	STOP
142	!
143	ENDIF
144	!
145	champ(:,:) = rugo(:,:)
146	!
147	CASE ('masque')
148	!
149	! If we do not have the orography we need to get it
150	!
151	IF ( .NOT.ALLOCATED(masque)) THEN
152	!
153	CALL start_init_orog( iml, jml, lon_in, lat_in,
154	. jml2,lon_in2,lat_in2 , interbar )
155	!
156	ENDIF
157	!
158	IF (SIZE(masque) .NE. SIZE(champ)) THEN
159	!
160	WRITE(,)
161	. 'STARTVAR module has been initialized to the wrong size'
162	STOP
163	!
164	ENDIF
165	!
166	champ(:,:) = masque(:,:)
167	!
168	CASE ('surfgeo')
169	!
170	! If we do not have the orography we need to get it
171	!
172	IF ( .NOT.ALLOCATED(phis)) THEN
173	!
174	CALL start_init_orog( iml, jml, lon_in, lat_in,
175	. jml2,lon_in2, lat_in2 , interbar )
176	!
177	ENDIF
178	!
179	IF (SIZE(phis) .NE. SIZE(champ)) THEN
180	!
181	WRITE(,)
182	. 'STARTVAR module has been initialized to the wrong size'
183	STOP
184	!
185	ENDIF
186	!
187	champ(:,:) = phis(:,:)
188	!
189	CASE ('psol')
190	!
191	! If we do not have the orography we need to get it
192	!
193	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
194	!
195	CALL start_init_dyn( iml, jml, lon_in, lat_in,
196	. jml2,lon_in2, lat_in2 , interbar )
197	!
198	ENDIF
199	!
200	IF (SIZE(psol_dyn) .NE. SIZE(champ)) THEN
201	!
202	WRITE(,)
203	. 'STARTVAR module has been initialized to the wrong size'
204	STOP
205	!
206	ENDIF
207	!
208	champ(:,:) = psol_dyn(:,:)
209	!
210	CASE DEFAULT
211	!
212	WRITE(,) 'startget_phys2d'
213	WRITE(,) 'No rule is present to extract variable',
214	. varname(:LEN_TRIM(varname)),' from any data set'
215	STOP
216	!
217	END SELECT
218	!
219	ELSE
220	!
221	! There are a few fields we might need if we need to interpolate 3D filed. Thus if they come through here we
222	! will catch them
223	!
224	SELECTCASE(varname)
225	!
226	CASE ('surfgeo')
227	!
228	IF ( .NOT.ALLOCATED(phis)) THEN
229	ALLOCATE(phis(iml,jml))
230	ENDIF
231	!
232	IF (SIZE(phis) .NE. SIZE(champ)) THEN
233	!
234	WRITE(,)
235	. 'STARTVAR module has been initialized to the wrong size'
236	STOP
237	!
238	ENDIF
239	!
240	phis(:,:) = champ(:,:)
241	!
242	END SELECT
243	!
244	ENDIF
245	!
246	END SUBROUTINE startget_phys2d
247	!
248	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
249	!
250	SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 ,
251	, lat_in2 , interbar, masque_lu )
252	!
253	INTEGER, INTENT(in) :: iml, jml, jml2
254	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
255	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
256	REAL, intent(in), optional :: masque_lu(iml,jml)
257	LOGICAL interbar
258	!
259	! LOCAL
260	!
261	LOGICAL interbar2
262	REAL :: lev(1), date, dt,chmin,chmax
263	INTEGER :: itau(1), fid
264	INTEGER :: llm_tmp, ttm_tmp
265	INTEGER :: i, j
266	INTEGER :: iret
267	CHARACTER*25 title
268	REAL, ALLOCATABLE :: relief_hi(:,:)
269	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
270	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
271	REAL, ALLOCATABLE :: tmp_var(:,:)
272	INTEGER, ALLOCATABLE :: tmp_int(:,:)
273	!
274	CHARACTER*120 :: orogfname
275	LOGICAL :: check=.TRUE.
276	!
277	!
278	orogfname = 'Relief.nc'
279	!
280	IF ( check ) WRITE(,) 'Reading the high resolution orography'
281	!
282	CALL flininfo(orogfname,iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
283	!
284	ALLOCATE (lat_rel(iml_rel,jml_rel), stat=iret)
285	ALLOCATE (lon_rel(iml_rel,jml_rel), stat=iret)
286	ALLOCATE (relief_hi(iml_rel,jml_rel), stat=iret)
287	!
288	CALL flinopen(orogfname, .FALSE., iml_rel, jml_rel,
289	.llm_tmp, lon_rel, lat_rel, lev, ttm_tmp,
290	. itau, date, dt, fid)
291	!
292	CALL flinget(fid, 'RELIEF', iml_rel, jml_rel, llm_tmp,
293	. ttm_tmp, 1, 1, relief_hi)
294	!
295	CALL flinclo(fid)
296	!
297	! In case we have a file which is in degrees we do the transformation
298	!
299	ALLOCATE(lon_rad(iml_rel))
300	ALLOCATE(lon_ini(iml_rel))
301
302	IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
303	lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
304	ELSE
305	lon_ini(:) = lon_rel(:,1)
306	ENDIF
307
308	ALLOCATE(lat_rad(jml_rel))
309	ALLOCATE(lat_ini(jml_rel))
310
311	IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
312	lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
313	ELSE
314	lat_ini(:) = lat_rel(1,:)
315	ENDIF
316	!
317	!
318
319	title='RELIEF'
320
321	interbar2 = .FALSE.
322	CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini,
323	. lon_rad, lat_rad, relief_hi , interbar2 )
324
325	IF ( check ) WRITE(,) 'Computes all the parameters needed',
326	.' for the gravity wave drag code'
327	!
328	! Allocate the data we need to put in the interpolated fields
329	!
330	! RELIEF: orographie moyenne
331	ALLOCATE(relief(iml,jml))
332	! zphi : orographie moyenne
333	ALLOCATE(phis(iml,jml))
334	! zstd: deviation standard de l'orographie sous-maille
335	ALLOCATE(zstd(iml,jml))
336	! zsig: pente de l'orographie sous-maille
337	ALLOCATE(zsig(iml,jml))
338	! zgam: anisotropy de l'orographie sous maille
339	ALLOCATE(zgam(iml,jml))
340	! zthe: orientation de l'axe oriente dans la direction
341	! de plus grande pente de l'orographie sous maille
342	ALLOCATE(zthe(iml,jml))
343	! zpic: hauteur pics de la SSO
344	ALLOCATE(zpic(iml,jml))
345	! zval: hauteur vallees de la SSO
346	ALLOCATE(zval(iml,jml))
347	! masque : Masque terre ocean
348	ALLOCATE(tmp_int(iml,jml))
349	ALLOCATE(masque(iml,jml))
350
351	masque = -99999.
352	if (present(masque_lu)) then
353	masque = masque_lu
354	endif
355	!
356	CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
357	. iml-1, jml, lon_in, lat_in,
358	. phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
359	phis = phis * 9.81
360	!
361	! masque(:,:) = FLOAT(tmp_int(:,:))
362	!
363	! Compute surface roughness
364	!
365	IF ( check ) WRITE(,)
366	.'Compute surface roughness induced by the orography'
367	!
368	ALLOCATE(rugo(iml,jml))
369	ALLOCATE(tmp_var(iml-1,jml))
370	!
371	CALL rugsoro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
372	. iml-1, jml, lon_in, lat_in, tmp_var)
373	!
374	DO j = 1, jml
375	DO i = 1, iml-1
376	rugo(i,j) = tmp_var(i,j)
377	ENDDO
378	rugo(iml,j) = tmp_var(1,j)
379	ENDDO
380	c
381	cc * rugo n'est pas utilise pour l'instant ****
382	!
383	! Build land-sea mask
384	!
385	!
386	RETURN
387	!
388	END SUBROUTINE start_init_orog
389	!
390	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
391	!
392	SUBROUTINE startget_phys1d(varname, iml, jml, lon_in,
393	.lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar)
394	!
395	CHARACTER(), INTENT(in) :: varname
396	INTEGER, INTENT(in) :: iml, jml, nbindex, jml2
397	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
398	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
399	REAL, INTENT(inout) :: champ(nbindex)
400	REAL, INTENT(in) :: val_exp
401	LOGICAL interbar
402	!
403	!
404	! This routine only works if the variable does not exist or is constant
405	!
406	IF ( MINVAL(champ(:)).EQ.MAXVAL(champ(:)) .AND.
407	.MINVAL(champ(:)).EQ.val_exp ) THEN
408	SELECTCASE(varname)
409	CASE ('tsol')
410	IF ( .NOT.ALLOCATED(tsol)) THEN
411	CALL start_init_phys( iml, jml, lon_in, lat_in,
412	. jml2, lon_in2, lat_in2, interbar )
413	ENDIF
414	IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
415	WRITE(,)
416	. 'STARTVAR module has been initialized to the wrong size'
417	STOP
418	ENDIF
419	CALL gr_dyn_fi(1, iml, jml, nbindex, tsol, champ)
420	CASE ('qsol')
421	IF ( .NOT.ALLOCATED(qsol)) THEN
422	CALL start_init_phys( iml, jml, lon_in, lat_in,
423	. jml2, lon_in2,lat_in2 , interbar )
424	ENDIF
425	IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
426	WRITE(,)
427	. 'STARTVAR module has been initialized to the wrong size'
428	STOP
429	ENDIF
430	CALL gr_dyn_fi(1, iml, jml, nbindex, qsol, champ)
431	CASE ('psol')
432	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
433	CALL start_init_dyn( iml, jml, lon_in, lat_in,
434	. jml2, lon_in2,lat_in2 , interbar )
435	ENDIF
436	IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN
437	WRITE(,)
438	. 'STARTVAR module has been initialized to the wrong size'
439	STOP
440	ENDIF
441	CALL gr_dyn_fi(1, iml, jml, nbindex, psol_dyn, champ)
442	CASE ('zmea')
443	IF ( .NOT.ALLOCATED(relief)) THEN
444	CALL start_init_orog( iml, jml, lon_in, lat_in,
445	. jml2, lon_in2,lat_in2 , interbar )
446	ENDIF
447	IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
448	WRITE(,)
449	. 'STARTVAR module has been initialized to the wrong size'
450	STOP
451	ENDIF
452	CALL gr_dyn_fi(1, iml, jml, nbindex, relief, champ)
453	CASE ('zstd')
454	IF ( .NOT.ALLOCATED(zstd)) THEN
455	CALL start_init_orog( iml, jml, lon_in, lat_in,
456	. jml2, lon_in2,lat_in2 , interbar )
457	ENDIF
458	IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
459	WRITE(,)
460	. 'STARTVAR module has been initialized to the wrong size'
461	STOP
462	ENDIF
463	CALL gr_dyn_fi(1, iml, jml, nbindex,zstd, champ)
464	CASE ('zsig')
465	IF ( .NOT.ALLOCATED(zsig)) THEN
466	CALL start_init_orog( iml, jml, lon_in, lat_in,
467	. jml2, lon_in2,lat_in2 , interbar )
468	ENDIF
469	IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
470	WRITE(,)
471	. 'STARTVAR module has been initialized to the wrong size'
472	STOP
473	ENDIF
474	CALL gr_dyn_fi(1, iml, jml, nbindex,zsig, champ)
475	CASE ('zgam')
476	IF ( .NOT.ALLOCATED(zgam)) THEN
477	CALL start_init_orog( iml, jml, lon_in, lat_in,
478	. jml2, lon_in2,lat_in2 , interbar )
479	ENDIF
480	IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
481	WRITE(,)
482	. 'STARTVAR module has been initialized to the wrong size'
483	STOP
484	ENDIF
485	CALL gr_dyn_fi(1, iml, jml, nbindex,zgam, champ)
486	CASE ('zthe')
487	IF ( .NOT.ALLOCATED(zthe)) THEN
488	CALL start_init_orog( iml, jml, lon_in, lat_in,
489	. jml2, lon_in2,lat_in2 , interbar )
490	ENDIF
491	IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
492	WRITE(,)
493	. 'STARTVAR module has been initialized to the wrong size'
494	STOP
495	ENDIF
496	CALL gr_dyn_fi(1, iml, jml, nbindex,zthe, champ)
497	CASE ('zpic')
498	IF ( .NOT.ALLOCATED(zpic)) THEN
499	CALL start_init_orog( iml, jml, lon_in, lat_in,
500	. jml2, lon_in2,lat_in2 , interbar )
501	ENDIF
502	IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
503	WRITE(,)
504	. 'STARTVAR module has been initialized to the wrong size'
505	STOP
506	ENDIF
507	CALL gr_dyn_fi(1, iml, jml, nbindex,zpic, champ)
508	CASE ('zval')
509	IF ( .NOT.ALLOCATED(zval)) THEN
510	CALL start_init_orog( iml, jml, lon_in, lat_in,
511	. jml2, lon_in2,lat_in2 , interbar )
512	ENDIF
513	IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
514	WRITE(,)
515	. 'STARTVAR module has been initialized to the wrong size'
516	STOP
517	ENDIF
518	CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ)
519	CASE ('rads')
520	champ(:) = 0.0
521	CASE ('snow')
522	champ(:) = 0.0
523	CASE ('deltat')
524	champ(:) = 0.0
525	CASE ('rugmer')
526	champ(:) = 0.001
527	CASE ('agsno')
528	champ(:) = 50.0
529	CASE DEFAULT
530	WRITE(,) 'startget_phys1d'
531	WRITE(,) 'No rule is present to extract variable ',
532	. varname(:LEN_TRIM(varname)),' from any data set'
533	STOP
534	END SELECT
535	ELSE
536	!
537	! If we see tsol we catch it as we may need it for a 3D interpolation
538	!
539	SELECTCASE(varname)
540	CASE ('tsol')
541	IF ( .NOT.ALLOCATED(tsol)) THEN
542	ALLOCATE(tsol(SIZE(lon_in),SIZE(lat_in) ))
543	ENDIF
544	CALL gr_fi_dyn(1, iml, jml, nbindex, champ, tsol)
545	END SELECT
546	ENDIF
547	END SUBROUTINE startget_phys1d
548	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
549	!
550	SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2,
551	. lon_in2, lat_in2 , interbar )
552	!
553	INTEGER, INTENT(in) :: iml, jml ,jml2
554	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
555	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
556	LOGICAL interbar
557	!
558	! LOCAL
559	!
560	!ac REAL :: lev(1), date, dt
561	REAL :: date, dt
562	REAL, DIMENSION(:), ALLOCATABLE :: levphys_ini
563	!ac
564	INTEGER :: itau(1)
565	INTEGER :: llm_tmp, ttm_tmp
566	INTEGER :: i, j
567	!
568	CHARACTER*25 title
569	CHARACTER*120 :: physfname
570	LOGICAL :: check=.TRUE.
571	!
572	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
573	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
574	REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:)
575	!
576	physfname = 'ECPHY.nc'
577	!
578	IF ( check ) WRITE(,) 'Opening the surface analysis'
579	!
580	CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp,
581	. ttm_tmp, fid_phys)
582	!
583	ALLOCATE (lat_phys(iml_phys,jml_phys))
584	ALLOCATE (lon_phys(iml_phys,jml_phys))
585	!ac
586	ALLOCATE (levphys_ini(llm_tmp))
587	!
588	! CALL flinopen(physfname, .FALSE., iml_phys, jml_phys,
589	! . llm_tmp, lon_phys, lat_phys, lev, ttm_tmp,
590	! . itau, date, dt, fid_phys)
591	!
592	CALL flinopen(physfname, .FALSE., iml_phys, jml_phys,
593	. llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp,
594	. itau, date, dt, fid_phys)
595	!
596	DEALLOCATE (levphys_ini)
597	!ac
598	!
599	! Allocate the space we will need to get the data out of this file
600	!
601	ALLOCATE(var_ana(iml_phys, jml_phys))
602	!
603	! In case we have a file which is in degrees we do the transformation
604	!
605	ALLOCATE(lon_rad(iml_phys))
606	ALLOCATE(lon_ini(iml_phys))
607
608	IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
609	lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
610	ELSE
611	lon_ini(:) = lon_phys(:,1)
612	ENDIF
613
614	ALLOCATE(lat_rad(jml_phys))
615	ALLOCATE(lat_ini(jml_phys))
616
617	IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
618	lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
619	ELSE
620	lat_ini(:) = lat_phys(1,:)
621	ENDIF
622
623
624	!
625	! We get the two standard varibales
626	! Surface temperature
627	!
628	ALLOCATE(tsol(iml,jml))
629	ALLOCATE(tmp_var(iml-1,jml))
630	!
631	!
632
633	CALL flinget(fid_phys, 'ST', iml_phys, jml_phys,
634	.llm_tmp, ttm_tmp, 1, 1, var_ana)
635
636	title='ST'
637	CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
638	. lon_rad, lat_rad, var_ana , interbar )
639
640	IF ( interbar ) THEN
641	WRITE(6,*) '-------------------------------------------------',
642	,'--------------'
643	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
644	, ' pour ST $$$ '
645	WRITE(6,*) '-------------------------------------------------',
646	,'--------------'
647	CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
648	, var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var )
649	ELSE
650	CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
651	. var_ana, iml-1, jml, lon_in, lat_in, tmp_var )
652	ENDIF
653
654	CALL gr_int_dyn(tmp_var, tsol, iml-1, jml)
655	!
656	! Soil moisture
657	!
658	ALLOCATE(qsol(iml,jml))
659	CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys,
660	. llm_tmp, ttm_tmp, 1, 1, var_ana)
661
662	title='CDSW'
663	CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
664	. lon_rad, lat_rad, var_ana, interbar )
665
666	IF ( interbar ) THEN
667	WRITE(6,*) '-------------------------------------------------',
668	,'--------------'
669	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
670	, ' pour CDSW $$$ '
671	WRITE(6,*) '-------------------------------------------------',
672	,'--------------'
673	CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
674	, var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var )
675	ELSE
676	CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
677	. var_ana, iml-1, jml, lon_in, lat_in, tmp_var )
678	ENDIF
679	c
680	CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
681	!
682	CALL flinclo(fid_phys)
683	!
684	END SUBROUTINE start_init_phys
685	!
686	!
687	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
688	!
689	!
690	SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in,
691	. lml, pls, workvar, champ, val_exp,jml2, lon_in2, lat_in2 ,
692	, interbar )
693	!
694	! ARGUMENTS
695	!
696	CHARACTER(), INTENT(in) :: varname
697	INTEGER, INTENT(in) :: iml, jml, lml, jml2
698	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
699	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
700	REAL, INTENT(in) :: pls(iml, jml, lml)
701	REAL, INTENT(in) :: workvar(iml, jml, lml)
702	REAL, INTENT(inout) :: champ(iml, jml, lml)
703	REAL, INTENT(in) :: val_exp
704	LOGICAL interbar
705	!
706	! LOCAL
707	!
708	INTEGER :: il, ij, ii
709	REAL :: xppn, xpps
710	!
711	#include "dimensions.h"
712	#include "paramet.h"
713	#include "comgeom2.h"
714	#include "comconst.h"
715	!
716	! This routine only works if the variable does not exist or is constant
717	!
718	IF ( MINVAL(champ(:,:,:)).EQ.MAXVAL(champ(:,:,:)) .AND.
719	. MINVAL(champ(:,:,:)).EQ.val_exp ) THEN
720	!
721	SELECTCASE(varname)
722	CASE ('u')
723	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
724	CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
725	. lon_in2,lat_in2 , interbar )
726	ENDIF
727	CALL start_inter_3d('U', iml, jml, lml, lon_in,
728	. lat_in, jml2, lon_in2, lat_in2, pls, champ,interbar )
729	DO il=1,lml
730	DO ij=1,jml
731	DO ii=1,iml-1
732	champ(ii,ij,il) = champ(ii,ij,il) * cu(ii,ij)
733	ENDDO
734	champ(iml,ij, il) = champ(1,ij, il)
735	ENDDO
736	ENDDO
737	CASE ('v')
738	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
739	CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2,
740	. lon_in2, lat_in2 , interbar )
741	ENDIF
742	CALL start_inter_3d('V', iml, jml, lml, lon_in,
743	. lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar )
744	DO il=1,lml
745	DO ij=1,jml
746	DO ii=1,iml-1
747	champ(ii,ij,il) = champ(ii,ij,il) * cv(ii,ij)
748	ENDDO
749	champ(iml,ij, il) = champ(1,ij, il)
750	ENDDO
751	ENDDO
752	CASE ('t')
753	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
754	CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
755	. lon_in2, lat_in2 ,interbar )
756	ENDIF
757	CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
758	. lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar )
759
760	CASE ('tpot')
761	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
762	CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 ,
763	. lon_in2, lat_in2 , interbar )
764	ENDIF
765	CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
766	. lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar )
767	IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
768	. THEN
769	DO il=1,lml
770	DO ij=1,jml
771	DO ii=1,iml-1
772	champ(ii,ij,il) = champ(ii,ij,il) * cpp
773	. / workvar(ii,ij,il)
774	ENDDO
775	champ(iml,ij,il) = champ(1,ij,il)
776	ENDDO
777	ENDDO
778	DO il=1,lml
779	xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
780	xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
781	champ(:,1,il) = xppn
782	champ(:,jml,il) = xpps
783	ENDDO
784	ELSE
785	WRITE(,)'Could not compute potential temperature as the'
786	WRITE(,)'Exner function is missing or constant.'
787	STOP
788	ENDIF
789	CASE ('q')
790	IF ( .NOT.ALLOCATED(psol_dyn)) THEN
791	CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
792	. lon_in2, lat_in2 , interbar )
793	ENDIF
794	CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in,
795	. jml2, lon_in2, lat_in2, pls, champ, interbar )
796	IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
797	. THEN
798	DO il=1,lml
799	DO ij=1,jml
800	DO ii=1,iml-1
801	champ(ii,ij,il) = 0.01 * champ(ii,ij,il) *
802	. workvar(ii,ij,il)
803	ENDDO
804	champ(iml,ij,il) = champ(1,ij,il)
805	ENDDO
806	ENDDO
807	WHERE ( champ .LT. 0.) champ = 1.0E-10
808	DO il=1,lml
809	xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
810	xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
811	champ(:,1,il) = xppn
812	champ(:,jml,il) = xpps
813	ENDDO
814	ELSE
815	WRITE(,)'Could not compute specific humidity as the'
816	WRITE(,)'saturated humidity is missing or constant.'
817	STOP
818	ENDIF
819	CASE DEFAULT
820	WRITE(,) 'startget_dyn'
821	WRITE(,) 'No rule is present to extract variable ',
822	. varname(:LEN_TRIM(varname)),' from any data set'
823	STOP
824	END SELECT
825	ENDIF
826	END SUBROUTINE startget_dyn
827	!
828	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
829	!
830	SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 ,
831	, lat_in2 , interbar )
832	!
833	INTEGER, INTENT(in) :: iml, jml, jml2
834	REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
835	REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
836	LOGICAL interbar
837	!
838	! LOCAL
839	!
840	REAL :: lev(1), date, dt
841	INTEGER :: itau(1)
842	INTEGER :: i, j
843	integer :: iret
844	!
845	CHARACTER*120 :: physfname
846	LOGICAL :: check=.TRUE.
847	!
848	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
849	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
850	REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:)
851	REAL, ALLOCATABLE :: xppn(:), xpps(:)
852	LOGICAL :: allo
853	!
854	!
855	#include "dimensions.h"
856	#include "paramet.h"
857	#include "comgeom2.h"
858
859	CHARACTER*25 title
860
861	!
862	physfname = 'ECDYN.nc'
863	!
864	IF ( check ) WRITE(,) 'Opening the surface analysis'
865	!
866	CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn,
867	. ttm_dyn, fid_dyn)
868	IF ( check ) WRITE(,) 'Values read: ', iml_dyn, jml_dyn,
869	. llm_dyn, ttm_dyn
870	!
871	ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret)
872	ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret)
873	ALLOCATE (levdyn_ini(llm_dyn), stat=iret)
874	!
875	CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn,
876	. lon_dyn, lat_dyn, levdyn_ini, ttm_dyn,
877	. itau, date, dt, fid_dyn)
878	!
879
880	allo = allocated (var_ana)
881	if (allo) then
882	DEALLOCATE(var_ana, stat=iret)
883	endif
884	ALLOCATE(var_ana(iml_dyn, jml_dyn), stat=iret)
885
886	allo = allocated (lon_rad)
887	if (allo) then
888	DEALLOCATE(lon_rad, stat=iret)
889	endif
890
891	ALLOCATE(lon_rad(iml_dyn), stat=iret)
892	ALLOCATE(lon_ini(iml_dyn))
893
894	IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
895	lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
896	ELSE
897	lon_ini(:) = lon_dyn(:,1)
898	ENDIF
899
900	ALLOCATE(lat_rad(jml_dyn))
901	ALLOCATE(lat_ini(jml_dyn))
902
903	IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
904	lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
905	ELSE
906	lat_ini(:) = lat_dyn(1,:)
907	ENDIF
908	!
909
910
911	ALLOCATE(z(iml, jml))
912	ALLOCATE(tmp_var(iml-1,jml))
913	!
914	CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn,
915	. 1, 1, var_ana)
916	c
917	title='Z'
918	CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
919	. lon_rad, lat_rad, var_ana, interbar )
920	c
921	IF ( interbar ) THEN
922	WRITE(6,*) '-------------------------------------------------',
923	,'--------------'
924	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
925	, ' pour Z $$$ '
926	WRITE(6,*) '-------------------------------------------------',
927	,'--------------'
928	CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
929	, var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var)
930	ELSE
931	CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
932	. iml-1, jml, lon_in, lat_in, tmp_var)
933	ENDIF
934
935	CALL gr_int_dyn(tmp_var, z, iml-1, jml)
936	!
937	ALLOCATE(psol_dyn(iml, jml))
938	!
939	CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn,
940	. 1, 1, var_ana)
941
942	title='SP'
943	CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
944	. lon_rad, lat_rad, var_ana, interbar )
945
946	IF ( interbar ) THEN
947	WRITE(6,*) '-------------------------------------------------',
948	,'--------------'
949	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
950	, ' pour SP $$$ '
951	WRITE(6,*) '-------------------------------------------------',
952	,'--------------'
953	CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
954	, var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var)
955	ELSE
956	CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
957	. iml-1, jml, lon_in, lat_in, tmp_var )
958	ENDIF
959
960	CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml)
961	!
962	IF ( .NOT.ALLOCATED(tsol)) THEN
963	! These variables may have been allocated by the need to
964	! create a start field for them or by the varibale
965	! coming out of the restart file. In case we dor have it we will initialize it.
966	!
967	CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2,
968	. lat_in2 , interbar )
969	ELSE
970	IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN
971	WRITE(,) 'start_init_dyn :'
972	WRITE(,) 'The temperature field we have does not ',
973	. 'have the right size'
974	STOP
975	ENDIF
976	ENDIF
977	IF ( .NOT.ALLOCATED(phis)) THEN
978	!
979	! These variables may have been allocated by the need to create a start field for them or by the varibale
980	! coming out of the restart file. In case we dor have it we will initialize it.
981	!
982	CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 ,
983	. lat_in2 , interbar )
984	!
985	ELSE
986	!
987	IF (SIZE(phis) .NE. SIZE(psol_dyn)) THEN
988	!
989	WRITE(,) 'start_init_dyn :'
990	WRITE(,) 'The orography field we have does not ',
991	. ' have the right size'
992	STOP
993	ENDIF
994	!
995	ENDIF
996	!
997	! PSOL is computed in Pascals
998	!
999	!
1000	DO j = 1, jml
1001	DO i = 1, iml-1
1002	psol_dyn(i,j) = psol_dyn(i,j)*(1.0+(z(i,j)-phis(i,j))
1003	. /287.0/tsol(i,j))
1004	ENDDO
1005	psol_dyn(iml,j) = psol_dyn(1,j)
1006	ENDDO
1007	!
1008	!
1009	ALLOCATE(xppn(iml-1))
1010	ALLOCATE(xpps(iml-1))
1011	!
1012	DO i = 1, iml-1
1013	xppn(i) = aire( i,1) * psol_dyn( i,1)
1014	xpps(i) = aire( i,jml) * psol_dyn( i,jml)
1015	ENDDO
1016	!
1017	DO i = 1, iml
1018	psol_dyn(i,1 ) = SUM(xppn)/apoln
1019	psol_dyn(i,jml) = SUM(xpps)/apols
1020	ENDDO
1021	!
1022	RETURN
1023	!
1024	END SUBROUTINE start_init_dyn
1025	!
1026	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1027	!
1028	SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in,
1029	. lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar )
1030	!
1031	! This subroutine gets a variables from a 3D file and does the interpolations needed
1032	!
1033	!
1034	! ARGUMENTS
1035	!
1036	CHARACTER() :: varname
1037	INTEGER :: iml, jml, lml, jml2
1038	REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml)
1039	REAL :: lon_in2(iml) , lat_in2(jml2)
1040	REAL :: var3d(iml, jml, lml)
1041	LOGICAL interbar
1042	real chmin,chmax
1043	!
1044	! LOCAL
1045	!
1046	CHARACTER*25 title
1047	INTEGER :: ii, ij, il, jsort,i,j,l
1048	REAL :: bx, by
1049	REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
1050	REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:)
1051	REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:)
1052	REAL, ALLOCATABLE :: ax(:), ay(:), yder(:)
1053	REAL, ALLOCATABLE :: varrr(:,:,:)
1054	INTEGER, ALLOCATABLE :: lind(:)
1055	!
1056	LOGICAL :: check = .TRUE.
1057	!
1058	IF ( .NOT. ALLOCATED(var_ana3d)) THEN
1059	ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
1060	ENDIF
1061	ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn))
1062	!
1063	!
1064	IF ( check) WRITE(,) 'Going into flinget to extract the 3D ',
1065	. ' field.', fid_dyn
1066	IF ( check) WRITE(,) fid_dyn, varname, iml_dyn, jml_dyn,
1067	. llm_dyn,ttm_dyn
1068	!
1069	CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn,
1070	. ttm_dyn, 1, 1, var_ana3d)
1071	!
1072	IF ( check) WRITE(,) 'Allocating space for the interpolation',
1073	. iml, jml, llm_dyn
1074	!
1075	ALLOCATE(lon_rad(iml_dyn))
1076	ALLOCATE(lon_ini(iml_dyn))
1077
1078	IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
1079	lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
1080	ELSE
1081	lon_ini(:) = lon_dyn(:,1)
1082	ENDIF
1083
1084	ALLOCATE(lat_rad(jml_dyn))
1085	ALLOCATE(lat_ini(jml_dyn))
1086
1087	ALLOCATE(lev_dyn(llm_dyn))
1088
1089	IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
1090	lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
1091	ELSE
1092	lat_ini(:) = lat_dyn(1,:)
1093	ENDIF
1094	!
1095
1096	CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini,
1097	. lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d ,
1098	, interbar )
1099
1100	ALLOCATE(var_tmp2d(iml-1, jml))
1101	ALLOCATE(var_tmp3d(iml, jml, llm_dyn))
1102	ALLOCATE(ax(llm_dyn))
1103	ALLOCATE(ay(llm_dyn))
1104	ALLOCATE(yder(llm_dyn))
1105	ALLOCATE(lind(llm_dyn))
1106	!
1107
1108	DO il=1,llm_dyn
1109	!
1110	IF( interbar ) THEN
1111	IF( il.EQ.1 ) THEN
1112	WRITE(6,*) '-------------------------------------------------',
1113	,'--------------'
1114	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
1115	, ' pour ', varname
1116	WRITE(6,*) '-------------------------------------------------',
1117	,'--------------'
1118	ENDIF
1119	CALL inter_barxy ( iml_dyn, jml_dyn -1,lon_rad, lat_rad,
1120	, var_ana3d(:,:,il),iml-1, jml2, lon_in2, lat_in2,jml,var_tmp2d )
1121	ELSE
1122	CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad,
1123	. var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d )
1124	ENDIF
1125	!
1126	CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml)
1127	!
1128	ENDDO
1129	!
1130	DO il=1,llm_dyn
1131	lind(il) = llm_dyn-il+1
1132	ENDDO
1133	!
1134	c
1135	c ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere
1136	c vers le sol ...
1137	c
1138	DO ij=1,jml
1139	DO ii=1,iml-1
1140	!
1141	ax(:) = lev_dyn(lind(:))
1142	ay(:) = var_tmp3d(ii, ij, lind(:))
1143	!
1144
1145	CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder)
1146	!
1147	DO il=1,lml
1148	bx = pls_in(ii, ij, il)
1149	CALL SPLINT(ax, ay, yder, llm_dyn, bx, by)
1150	var3d(ii, ij, il) = by
1151	ENDDO
1152	!
1153	ENDDO
1154	var3d(iml, ij, :) = var3d(1, ij, :)
1155	ENDDO
1156
1157	do il=1,lml
1158	call minmax(iml*jml,var3d(1,1,il),chmin,chmax)
1159	SELECTCASE(varname)
1160	CASE('U')
1161	WRITE(,) ' U min max l ',il,chmin,chmax
1162	CASE('V')
1163	WRITE(,) ' V min max l ',il,chmin,chmax
1164	CASE('TEMP')
1165	WRITE(,) ' TEMP min max l ',il,chmin,chmax
1166	CASE('R')
1167	WRITE(,) ' R min max l ',il,chmin,chmax
1168	END SELECT
1169	enddo
1170
1171	DEALLOCATE(lon_rad)
1172	DEALLOCATE(lat_rad)
1173	DEALLOCATE(var_tmp2d)
1174	DEALLOCATE(var_tmp3d)
1175	DEALLOCATE(ax)
1176	DEALLOCATE(ay)
1177	DEALLOCATE(yder)
1178	DEALLOCATE(lind)
1179
1180	!
1181	RETURN
1182	!
1183	END SUBROUTINE start_inter_3d
1184	!
1185	END MODULE startvar

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

Download in other formats:

Original Format