Context Navigation

phyetat0.F @ 868

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

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

Download in other formats:

Original Format