Context Navigation

readstartphy.F @ 1198

Last change on this file since 1198 was 808, checked in by slebonnois, 12 years ago
SL: Many changes for VENUS (related to newstart) and TITAN (related to clouds). Please read DOC/chantiers/commit_importants.log (cf v808).
File size: 12.8 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,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	cIM BEG alblw
32	REAL alblw(ngridmx)
33	cIM END alblw
34	REAL radsol(ngridmx)
35	REAL sollw(ngridmx)
36	real solsw(ngridmx)
37	real fder(ngridmx)
38	REAL zmea(ngridmx), zstd(ngridmx)
39	REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx)
40	REAL zpic(ngridmx), zval(ngridmx)
41	INTEGER length
42	PARAMETER (length=100)
43	REAL tabcntr0(length)
44
45	REAL xmin, xmax
46	c
47	INTEGER nid, nvarid
48	INTEGER ierr, i, nsrf, isoil
49	CHARACTER*2 str2
50	c
51	c Ouvrir le fichier contenant l'etat initial:
52	c
53	print*,'fichnom',fichnom
54	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
55	IF (ierr.NE.NF_NOERR) THEN
56	write(6,*)' Pb d''ouverture du fichier '//fichnom
57	write(6,*)' ierr = ', ierr
58	CALL ABORT
59	ENDIF
60	c
61	c Lecture des parametres de controle:
62	c
63	ierr = NF_INQ_VARID (nid, "controle", nvarid)
64	IF (ierr.NE.NF_NOERR) THEN
65	PRINT*, 'phyetat0: Le champ <controle> est absent'
66	CALL abort
67	ENDIF
68	#ifdef NC_DOUBLE
69	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
70	#else
71	ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
72	#endif
73	IF (ierr.NE.NF_NOERR) THEN
74	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
75	CALL abort
76	ENDIF
77	c
78	c
79	c Lecture des latitudes (coordonnees):
80	c
81	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
82	IF (ierr.NE.NF_NOERR) THEN
83	PRINT*, 'phyetat0: Le champ <latitude> est absent'
84	CALL abort
85	ENDIF
86	#ifdef NC_DOUBLE
87	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
88	#else
89	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
90	#endif
91	IF (ierr.NE.NF_NOERR) THEN
92	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
93	CALL abort
94	ENDIF
95	c
96	c Lecture des longitudes (coordonnees):
97	c
98	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
99	IF (ierr.NE.NF_NOERR) THEN
100	PRINT*, 'phyetat0: Le champ <longitude> est absent'
101	CALL abort
102	ENDIF
103	#ifdef NC_DOUBLE
104	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
105	#else
106	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
107	#endif
108	IF (ierr.NE.NF_NOERR) THEN
109	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
110	CALL abort
111	ENDIF
112	C
113	c Lecture des temperatures du sol:
114	c
115	ierr = NF_INQ_VARID (nid, "TS", nvarid)
116	IF (ierr.NE.NF_NOERR) THEN
117	PRINT*, 'phyetat0: Le champ <TS> est absent'
118	PRINT*, "phyetat0: Lecture echouee pour <TS>"
119	CALL abort
120	ELSE
121	PRINT*, 'phyetat0: Le champ <TS> est present'
122	#ifdef NC_DOUBLE
123	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol)
124	#else
125	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol)
126	#endif
127	IF (ierr.NE.NF_NOERR) THEN
128	PRINT*, "phyetat0: Lecture echouee pour <TS>"
129	CALL abort
130	ENDIF
131	xmin = 1.0E+20
132	xmax = -1.0E+20
133	DO i = 1, ngridmx
134	xmin = MIN(tsol(i),xmin)
135	xmax = MAX(tsol(i),xmax)
136	ENDDO
137	PRINT*,'Temperature du sol <TS>', xmin, xmax
138	ENDIF
139	c
140	c Lecture des temperatures du sol profond:
141	c
142	DO isoil=1, nsoilmx
143	IF (isoil.GT.99) THEN
144	PRINT*, "Trop de couches"
145	CALL abort
146	ENDIF
147	WRITE(str2,'(i2.2)') isoil
148	ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
149	IF (ierr.NE.NF_NOERR) THEN
150	PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
151	PRINT*, " Il prend donc la valeur de surface"
152	DO i=1, ngridmx
153	tsoil(i,isoil)=tsol(i)
154	ENDDO
155	ELSE
156	#ifdef NC_DOUBLE
157	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
158	#else
159	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
160	#endif
161	IF (ierr.NE.NF_NOERR) THEN
162	PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
163	CALL abort
164	ENDIF
165	ENDIF
166	ENDDO
167
168	c
169	c Lecture de albedo au sol:
170	c
171	ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
172	IF (ierr.NE.NF_NOERR) THEN
173	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
174	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
175	CALL abort
176	ELSE
177	PRINT*, 'phyetat0: Le champ <ALBE> est present'
178	#ifdef NC_DOUBLE
179	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
180	#else
181	ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
182	#endif
183	IF (ierr.NE.NF_NOERR) THEN
184	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
185	CALL abort
186	ENDIF
187	xmin = 1.0E+20
188	xmax = -1.0E+20
189	DO i = 1, ngridmx
190	xmin = MIN(albe(i),xmin)
191	xmax = MAX(albe(i),xmax)
192	ENDDO
193	PRINT*,'Albedo du sol <ALBE>', xmin, xmax
194	ENDIF
195
196	c
197	c Lecture rayonnement solaire au sol:
198	c
199	ierr = NF_INQ_VARID (nid, "solsw", nvarid)
200	IF (ierr.NE.NF_NOERR) THEN
201	PRINT*, 'phyetat0: Le champ <solsw> est absent'
202	PRINT*, 'mis a zero'
203	solsw = 0.
204	ELSE
205	#ifdef NC_DOUBLE
206	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
207	#else
208	ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
209	#endif
210	IF (ierr.NE.NF_NOERR) THEN
211	PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
212	CALL abort
213	ENDIF
214	ENDIF
215	xmin = 1.0E+20
216	xmax = -1.0E+20
217	DO i = 1, ngridmx
218	xmin = MIN(solsw(i),xmin)
219	xmax = MAX(solsw(i),xmax)
220	ENDDO
221	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
222	c
223	c Lecture rayonnement IF au sol:
224	c
225	ierr = NF_INQ_VARID (nid, "sollw", nvarid)
226	IF (ierr.NE.NF_NOERR) THEN
227	PRINT*, 'phyetat0: Le champ <sollw> est absent'
228	PRINT*, 'mis a zero'
229	sollw = 0.
230	ELSE
231	#ifdef NC_DOUBLE
232	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
233	#else
234	ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
235	#endif
236	IF (ierr.NE.NF_NOERR) THEN
237	PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
238	CALL abort
239	ENDIF
240	ENDIF
241	xmin = 1.0E+20
242	xmax = -1.0E+20
243	DO i = 1, ngridmx
244	xmin = MIN(sollw(i),xmin)
245	xmax = MAX(sollw(i),xmax)
246	ENDDO
247	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
248
249	c
250	c Lecture derive des flux:
251	c
252	ierr = NF_INQ_VARID (nid, "fder", nvarid)
253	IF (ierr.NE.NF_NOERR) THEN
254	PRINT*, 'phyetat0: Le champ <fder> est absent'
255	PRINT*, 'mis a zero'
256	fder = 0.
257	ELSE
258	#ifdef NC_DOUBLE
259	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
260	#else
261	ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
262	#endif
263	IF (ierr.NE.NF_NOERR) THEN
264	PRINT*, 'phyetat0: Lecture echouee pour <fder>'
265	CALL abort
266	ENDIF
267	ENDIF
268	xmin = 1.0E+20
269	xmax = -1.0E+20
270	DO i = 1, ngridmx
271	xmin = MIN(fder(i),xmin)
272	xmax = MAX(fder(i),xmax)
273	ENDDO
274	PRINT*,'Derive des flux fder:', xmin, xmax
275
276	c
277	c Lecture du rayonnement net au sol:
278	c
279	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
280	IF (ierr.NE.NF_NOERR) THEN
281	PRINT*, 'phyetat0: Le champ <RADS> est absent'
282	CALL abort
283	ENDIF
284	#ifdef NC_DOUBLE
285	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
286	#else
287	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
288	#endif
289	IF (ierr.NE.NF_NOERR) THEN
290	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
291	CALL abort
292	ENDIF
293	xmin = 1.0E+20
294	xmax = -1.0E+20
295	DO i = 1, ngridmx
296	xmin = MIN(radsol(i),xmin)
297	xmax = MAX(radsol(i),xmax)
298	ENDDO
299	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
300
301	c
302	c Lecture des parametres orographie sous-maille:
303	c
304	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
305	IF (ierr.NE.NF_NOERR) THEN
306	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
307	PRINT*, 'mis a zero'
308	zmea = 0.
309	ELSE
310	#ifdef NC_DOUBLE
311	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
312	#else
313	ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
314	#endif
315	IF (ierr.NE.NF_NOERR) THEN
316	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
317	CALL abort
318	ENDIF
319	ENDIF
320	xmin = 1.0E+20
321	xmax = -1.0E+20
322	DO i = 1, ngridmx
323	xmin = MIN(zmea(i),xmin)
324	xmax = MAX(zmea(i),xmax)
325	ENDDO
326	PRINT*,'zmea:', xmin, xmax
327	c
328	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
329	IF (ierr.NE.NF_NOERR) THEN
330	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
331	PRINT*, 'mis a zero'
332	zstd = 0.
333	ELSE
334	#ifdef NC_DOUBLE
335	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
336	#else
337	ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
338	#endif
339	IF (ierr.NE.NF_NOERR) THEN
340	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
341	CALL abort
342	ENDIF
343	ENDIF
344	xmin = 1.0E+20
345	xmax = -1.0E+20
346	DO i = 1, ngridmx
347	xmin = MIN(zstd(i),xmin)
348	xmax = MAX(zstd(i),xmax)
349	ENDDO
350	PRINT*,'zstd:', xmin, xmax
351	c
352	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
353	IF (ierr.NE.NF_NOERR) THEN
354	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
355	PRINT*, 'mis a zero'
356	zsig = 0.
357	ELSE
358	#ifdef NC_DOUBLE
359	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
360	#else
361	ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
362	#endif
363	IF (ierr.NE.NF_NOERR) THEN
364	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
365	CALL abort
366	ENDIF
367	ENDIF
368	xmin = 1.0E+20
369	xmax = -1.0E+20
370	DO i = 1, ngridmx
371	xmin = MIN(zsig(i),xmin)
372	xmax = MAX(zsig(i),xmax)
373	ENDDO
374	PRINT*,'zsig:', xmin, xmax
375	c
376	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
377	IF (ierr.NE.NF_NOERR) THEN
378	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
379	PRINT*, 'mis a zero'
380	zgam = 0.
381	ELSE
382	#ifdef NC_DOUBLE
383	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
384	#else
385	ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
386	#endif
387	IF (ierr.NE.NF_NOERR) THEN
388	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
389	CALL abort
390	ENDIF
391	ENDIF
392	xmin = 1.0E+20
393	xmax = -1.0E+20
394	DO i = 1, ngridmx
395	xmin = MIN(zgam(i),xmin)
396	xmax = MAX(zgam(i),xmax)
397	ENDDO
398	PRINT*,'zgam:', xmin, xmax
399	c
400	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
401	IF (ierr.NE.NF_NOERR) THEN
402	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
403	PRINT*, 'mis a zero'
404	zthe = 0.
405	ELSE
406	#ifdef NC_DOUBLE
407	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
408	#else
409	ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
410	#endif
411	IF (ierr.NE.NF_NOERR) THEN
412	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
413	CALL abort
414	ENDIF
415	ENDIF
416	xmin = 1.0E+20
417	xmax = -1.0E+20
418	DO i = 1, ngridmx
419	xmin = MIN(zthe(i),xmin)
420	xmax = MAX(zthe(i),xmax)
421	ENDDO
422	PRINT*,'zthe:', xmin, xmax
423	c
424	ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
425	IF (ierr.NE.NF_NOERR) THEN
426	PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
427	PRINT*, 'mis a zero'
428	zpic = 0.
429	ELSE
430	#ifdef NC_DOUBLE
431	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
432	#else
433	ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
434	#endif
435	IF (ierr.NE.NF_NOERR) THEN
436	PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
437	CALL abort
438	ENDIF
439	ENDIF
440	xmin = 1.0E+20
441	xmax = -1.0E+20
442	DO i = 1, ngridmx
443	xmin = MIN(zpic(i),xmin)
444	xmax = MAX(zpic(i),xmax)
445	ENDDO
446	PRINT*,'zpic:', xmin, xmax
447	c
448	ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
449	IF (ierr.NE.NF_NOERR) THEN
450	PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
451	PRINT*, 'mis a zero'
452	zval = 0.
453	ELSE
454	#ifdef NC_DOUBLE
455	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
456	#else
457	ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
458	#endif
459	IF (ierr.NE.NF_NOERR) THEN
460	PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
461	CALL abort
462	ENDIF
463	ENDIF
464	xmin = 1.0E+20
465	xmax = -1.0E+20
466	DO i = 1, ngridmx
467	xmin = MIN(zval(i),xmin)
468	xmax = MAX(zval(i),xmax)
469	ENDDO
470	PRINT*,'zval:', xmin, xmax
471	c
472	c Fermer le fichier:
473	c
474	ierr = NF_CLOSE(nid)
475	c
476	RETURN
477	END
478

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

Download in other formats:

Original Format