Context Navigation

phyetat0.F @ 100

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

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

Download in other formats:

Original Format