Context Navigation

phyetat0.F @ 109

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

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

Download in other formats:

Original Format