Context Navigation

readstartphy.F @ 1314

Last change on this file since 1314 was 1301, checked in by slebonnois, 11 years ago
SL: many bug corrections in phyvenus, some cleaning, and a new ksi matrix format for Venus IR
File size: 14.2 KB

Line
1	!
2	! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
3	!
4	c
5	c
6	SUBROUTINE readstartphy(fichnom,
7	. rlat,rlon, tsol,tsoil,
8	. albe, solsw, sollw,
9	. fder,dlw, sollwdown, radsol,
10	. zmea, zstd, zsig, zgam, zthe, zpic, zval,
11	. tabcntr0)
12	c======================================================================
13	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
14	c Objet: Lecture de l'etat initial pour la physique
15	c======================================================================
16	use dimphy
17	IMPLICIT none
18	#include "dimensions.h"
19	#include "netcdf.inc"
20	#include "dimsoil.h"
21	#include "temps.h"
22	c======================================================================
23	integer ngridmx
24	parameter (ngridmx=(2+(jjm-1)*iim - 1/jjm))
25
26	CHARACTER() fichnom
27	REAL rlat(ngridmx), rlon(ngridmx)
28	REAL tsol(ngridmx)
29	REAL tsoil(ngridmx,nsoilmx)
30	REAL albe(ngridmx)
31	REAL radsol(ngridmx)
32	REAL sollw(ngridmx)
33	real solsw(ngridmx)
34	real fder(ngridmx)
35	real dlw(ngridmx)
36	real sollwdown(ngridmx)
37	REAL zmea(ngridmx), zstd(ngridmx)
38	REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx)
39	REAL zpic(ngridmx), zval(ngridmx)
40	INTEGER length
41	PARAMETER (length=100)
42	REAL tabcntr0(length)
43
44	REAL xmin, xmax
45	c
46	INTEGER nid, nvarid
47	INTEGER ierr, i, nsrf, isoil
48	CHARACTER*2 str2
49	c
50	c Ouvrir le fichier contenant l'etat initial:
51	c
52	print*,'fichnom',fichnom
53	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
54	IF (ierr.NE.NF_NOERR) THEN
55	write(6,*)' Pb d''ouverture du fichier '//fichnom
56	write(6,*)' ierr = ', ierr
57	CALL ABORT
58	ENDIF
59	c
60	c Lecture des parametres de controle:
61	c
62	ierr = NF_INQ_VARID (nid, "controle", nvarid)
63	IF (ierr.NE.NF_NOERR) THEN
64	PRINT*, 'phyetat0: Le champ <controle> est absent'
65	CALL abort
66	ENDIF
67	#ifdef NC_DOUBLE
68	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
69	#else
70	ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
71	#endif
72	IF (ierr.NE.NF_NOERR) THEN
73	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
74	CALL abort
75	ENDIF
76	c
77	c
78	c Lecture des latitudes (coordonnees):
79	c
80	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
81	IF (ierr.NE.NF_NOERR) THEN
82	PRINT*, 'phyetat0: Le champ <latitude> est absent'
83	CALL abort
84	ENDIF
85	#ifdef NC_DOUBLE
86	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
87	#else
88	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
89	#endif
90	IF (ierr.NE.NF_NOERR) THEN
91	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
92	CALL abort
93	ENDIF
94	c
95	c Lecture des longitudes (coordonnees):
96	c
97	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
98	IF (ierr.NE.NF_NOERR) THEN
99	PRINT*, 'phyetat0: Le champ <longitude> est absent'
100	CALL abort
101	ENDIF
102	#ifdef NC_DOUBLE
103	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
104	#else
105	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
106	#endif
107	IF (ierr.NE.NF_NOERR) THEN
108	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
109	CALL abort
110	ENDIF
111	C
112	c Lecture des temperatures du sol:
113	c
114	ierr = NF_INQ_VARID (nid, "TS", nvarid)
115	IF (ierr.NE.NF_NOERR) THEN
116	PRINT*, 'phyetat0: Le champ <TS> est absent'
117	PRINT*, "phyetat0: Lecture echouee pour <TS>"
118	CALL abort
119	ELSE
120	PRINT*, 'phyetat0: Le champ <TS> est present'
121	#ifdef NC_DOUBLE
122	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol)
123	#else
124	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol)
125	#endif
126	IF (ierr.NE.NF_NOERR) THEN
127	PRINT*, "phyetat0: Lecture echouee pour <TS>"
128	CALL abort
129	ENDIF
130	xmin = 1.0E+20
131	xmax = -1.0E+20
132	DO i = 1, ngridmx
133	xmin = MIN(tsol(i),xmin)
134	xmax = MAX(tsol(i),xmax)
135	ENDDO
136	PRINT*,'Temperature du sol <TS>', xmin, xmax
137	ENDIF
138	c
139	c Lecture des temperatures du sol profond:
140	c
141	DO isoil=1, nsoilmx
142	IF (isoil.GT.99) THEN
143	PRINT*, "Trop de couches"
144	CALL abort
145	ENDIF
146	WRITE(str2,'(i2.2)') isoil
147	ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
148	IF (ierr.NE.NF_NOERR) THEN
149	PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
150	PRINT*, " Il prend donc la valeur de surface"
151	DO i=1, ngridmx
152	tsoil(i,isoil)=tsol(i)
153	ENDDO
154	ELSE
155	#ifdef NC_DOUBLE
156	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
157	#else
158	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
159	#endif
160	IF (ierr.NE.NF_NOERR) THEN
161	PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
162	CALL abort
163	ENDIF
164	ENDIF
165	ENDDO
166
167	c
168	c Lecture de albedo au sol:
169	c
170	ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
171	IF (ierr.NE.NF_NOERR) THEN
172	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
173	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
174	CALL abort
175	ELSE
176	PRINT*, 'phyetat0: Le champ <ALBE> est present'
177	#ifdef NC_DOUBLE
178	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
179	#else
180	ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
181	#endif
182	IF (ierr.NE.NF_NOERR) THEN
183	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
184	CALL abort
185	ENDIF
186	xmin = 1.0E+20
187	xmax = -1.0E+20
188	DO i = 1, ngridmx
189	xmin = MIN(albe(i),xmin)
190	xmax = MAX(albe(i),xmax)
191	ENDDO
192	PRINT*,'Albedo du sol <ALBE>', xmin, xmax
193	ENDIF
194
195	c
196	c Lecture rayonnement solaire au sol:
197	c
198	ierr = NF_INQ_VARID (nid, "solsw", nvarid)
199	IF (ierr.NE.NF_NOERR) THEN
200	PRINT*, 'phyetat0: Le champ <solsw> est absent'
201	PRINT*, 'mis a zero'
202	solsw = 0.
203	ELSE
204	#ifdef NC_DOUBLE
205	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
206	#else
207	ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
208	#endif
209	IF (ierr.NE.NF_NOERR) THEN
210	PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
211	CALL abort
212	ENDIF
213	ENDIF
214	xmin = 1.0E+20
215	xmax = -1.0E+20
216	DO i = 1, ngridmx
217	xmin = MIN(solsw(i),xmin)
218	xmax = MAX(solsw(i),xmax)
219	ENDDO
220	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
221	c
222	c Lecture rayonnement IF au sol:
223	c
224	ierr = NF_INQ_VARID (nid, "sollw", nvarid)
225	IF (ierr.NE.NF_NOERR) THEN
226	PRINT*, 'phyetat0: Le champ <sollw> est absent'
227	PRINT*, 'mis a zero'
228	sollw = 0.
229	ELSE
230	#ifdef NC_DOUBLE
231	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
232	#else
233	ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
234	#endif
235	IF (ierr.NE.NF_NOERR) THEN
236	PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
237	CALL abort
238	ENDIF
239	ENDIF
240	xmin = 1.0E+20
241	xmax = -1.0E+20
242	DO i = 1, ngridmx
243	xmin = MIN(sollw(i),xmin)
244	xmax = MAX(sollw(i),xmax)
245	ENDDO
246	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
247
248	c
249	c Lecture derive des flux:
250	c
251	ierr = NF_INQ_VARID (nid, "fder", nvarid)
252	IF (ierr.NE.NF_NOERR) THEN
253	PRINT*, 'phyetat0: Le champ <fder> est absent'
254	PRINT*, 'mis a zero'
255	fder = 0.
256	ELSE
257	#ifdef NC_DOUBLE
258	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
259	#else
260	ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
261	#endif
262	IF (ierr.NE.NF_NOERR) THEN
263	PRINT*, 'phyetat0: Lecture echouee pour <fder>'
264	CALL abort
265	ENDIF
266	ENDIF
267	xmin = 1.0E+20
268	xmax = -1.0E+20
269	DO i = 1, ngridmx
270	xmin = MIN(fder(i),xmin)
271	xmax = MAX(fder(i),xmax)
272	ENDDO
273	PRINT*,'Derive des flux fder:', xmin, xmax
274
275	c
276	c Lecture derive des flux IR:
277	c
278	ierr = NF_INQ_VARID (nid, "dlw", nvarid)
279	IF (ierr.NE.NF_NOERR) THEN
280	PRINT*, 'phyetat0: Le champ <dlw> est absent'
281	PRINT*, 'mis a zero'
282	dlw = 0.
283	ELSE
284	#ifdef NC_DOUBLE
285	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, dlw)
286	#else
287	ierr = NF_GET_VAR_REAL(nid, nvarid, dlw)
288	#endif
289	IF (ierr.NE.NF_NOERR) THEN
290	PRINT*, 'phyetat0: Lecture echouee pour <dlw>'
291	CALL abort
292	ENDIF
293	ENDIF
294	xmin = 1.0E+20
295	xmax = -1.0E+20
296	DO i = 1, ngridmx
297	xmin = MIN(dlw(i),xmin)
298	xmax = MAX(dlw(i),xmax)
299	ENDDO
300	PRINT*,'Derive des flux IR dlw:', xmin, xmax
301
302	c
303	c Lecture rayonnement IR vers le bas au sol:
304	c
305	ierr = NF_INQ_VARID (nid, "sollwdown", nvarid)
306	IF (ierr.NE.NF_NOERR) THEN
307	PRINT*, 'phyetat0: Le champ <sollwdown> est absent'
308	PRINT*, 'mis a zero'
309	sollwdown = 0.
310	ELSE
311	#ifdef NC_DOUBLE
312	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollwdown)
313	#else
314	ierr = NF_GET_VAR_REAL(nid, nvarid, sollwdown)
315	#endif
316	IF (ierr.NE.NF_NOERR) THEN
317	PRINT*, 'phyetat0: Lecture echouee pour <sollwdown>'
318	CALL abort
319	ENDIF
320	ENDIF
321	xmin = 1.0E+20
322	xmax = -1.0E+20
323	DO i = 1, ngridmx
324	xmin = MIN(sollwdown(i),xmin)
325	xmax = MAX(sollwdown(i),xmax)
326	ENDDO
327	PRINT*,'Flux IR vers le bas au sol sollwdown:', xmin, xmax
328
329	c
330	c Lecture du rayonnement net au sol:
331	c
332	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
333	IF (ierr.NE.NF_NOERR) THEN
334	PRINT*, 'phyetat0: Le champ <RADS> est absent'
335	CALL abort
336	ENDIF
337	#ifdef NC_DOUBLE
338	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
339	#else
340	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
341	#endif
342	IF (ierr.NE.NF_NOERR) THEN
343	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
344	CALL abort
345	ENDIF
346	xmin = 1.0E+20
347	xmax = -1.0E+20
348	DO i = 1, ngridmx
349	xmin = MIN(radsol(i),xmin)
350	xmax = MAX(radsol(i),xmax)
351	ENDDO
352	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
353
354	c
355	c Lecture des parametres orographie sous-maille:
356	c
357	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
358	IF (ierr.NE.NF_NOERR) THEN
359	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
360	PRINT*, 'mis a zero'
361	zmea = 0.
362	ELSE
363	#ifdef NC_DOUBLE
364	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
365	#else
366	ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
367	#endif
368	IF (ierr.NE.NF_NOERR) THEN
369	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
370	CALL abort
371	ENDIF
372	ENDIF
373	xmin = 1.0E+20
374	xmax = -1.0E+20
375	DO i = 1, ngridmx
376	xmin = MIN(zmea(i),xmin)
377	xmax = MAX(zmea(i),xmax)
378	ENDDO
379	PRINT*,'zmea:', xmin, xmax
380	c
381	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
382	IF (ierr.NE.NF_NOERR) THEN
383	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
384	PRINT*, 'mis a zero'
385	zstd = 0.
386	ELSE
387	#ifdef NC_DOUBLE
388	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
389	#else
390	ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
391	#endif
392	IF (ierr.NE.NF_NOERR) THEN
393	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
394	CALL abort
395	ENDIF
396	ENDIF
397	xmin = 1.0E+20
398	xmax = -1.0E+20
399	DO i = 1, ngridmx
400	xmin = MIN(zstd(i),xmin)
401	xmax = MAX(zstd(i),xmax)
402	ENDDO
403	PRINT*,'zstd:', xmin, xmax
404	c
405	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
406	IF (ierr.NE.NF_NOERR) THEN
407	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
408	PRINT*, 'mis a zero'
409	zsig = 0.
410	ELSE
411	#ifdef NC_DOUBLE
412	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
413	#else
414	ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
415	#endif
416	IF (ierr.NE.NF_NOERR) THEN
417	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
418	CALL abort
419	ENDIF
420	ENDIF
421	xmin = 1.0E+20
422	xmax = -1.0E+20
423	DO i = 1, ngridmx
424	xmin = MIN(zsig(i),xmin)
425	xmax = MAX(zsig(i),xmax)
426	ENDDO
427	PRINT*,'zsig:', xmin, xmax
428	c
429	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
430	IF (ierr.NE.NF_NOERR) THEN
431	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
432	PRINT*, 'mis a zero'
433	zgam = 0.
434	ELSE
435	#ifdef NC_DOUBLE
436	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
437	#else
438	ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
439	#endif
440	IF (ierr.NE.NF_NOERR) THEN
441	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
442	CALL abort
443	ENDIF
444	ENDIF
445	xmin = 1.0E+20
446	xmax = -1.0E+20
447	DO i = 1, ngridmx
448	xmin = MIN(zgam(i),xmin)
449	xmax = MAX(zgam(i),xmax)
450	ENDDO
451	PRINT*,'zgam:', xmin, xmax
452	c
453	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
454	IF (ierr.NE.NF_NOERR) THEN
455	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
456	PRINT*, 'mis a zero'
457	zthe = 0.
458	ELSE
459	#ifdef NC_DOUBLE
460	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
461	#else
462	ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
463	#endif
464	IF (ierr.NE.NF_NOERR) THEN
465	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
466	CALL abort
467	ENDIF
468	ENDIF
469	xmin = 1.0E+20
470	xmax = -1.0E+20
471	DO i = 1, ngridmx
472	xmin = MIN(zthe(i),xmin)
473	xmax = MAX(zthe(i),xmax)
474	ENDDO
475	PRINT*,'zthe:', xmin, xmax
476	c
477	ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
478	IF (ierr.NE.NF_NOERR) THEN
479	PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
480	PRINT*, 'mis a zero'
481	zpic = 0.
482	ELSE
483	#ifdef NC_DOUBLE
484	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
485	#else
486	ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
487	#endif
488	IF (ierr.NE.NF_NOERR) THEN
489	PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
490	CALL abort
491	ENDIF
492	ENDIF
493	xmin = 1.0E+20
494	xmax = -1.0E+20
495	DO i = 1, ngridmx
496	xmin = MIN(zpic(i),xmin)
497	xmax = MAX(zpic(i),xmax)
498	ENDDO
499	PRINT*,'zpic:', xmin, xmax
500	c
501	ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
502	IF (ierr.NE.NF_NOERR) THEN
503	PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
504	PRINT*, 'mis a zero'
505	zval = 0.
506	ELSE
507	#ifdef NC_DOUBLE
508	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
509	#else
510	ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
511	#endif
512	IF (ierr.NE.NF_NOERR) THEN
513	PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
514	CALL abort
515	ENDIF
516	ENDIF
517	xmin = 1.0E+20
518	xmax = -1.0E+20
519	DO i = 1, ngridmx
520	xmin = MIN(zval(i),xmin)
521	xmax = MAX(zval(i),xmax)
522	ENDDO
523	PRINT*,'zval:', xmin, xmax
524	c
525	c Fermer le fichier:
526	c
527	ierr = NF_CLOSE(nid)
528	c
529	RETURN
530	END
531

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

Download in other formats:

Original Format