Context Navigation

readstartphy.F @ 134

Last change on this file since 134 was 102, checked in by slebonnois, 14 years ago
SL : corrections et modifications dans phytitan correspondant a celles faites apres compilation Venus. Titan pas encore compile.
File size: 8.0 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	. tabcntr0)
11	c======================================================================
12	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
13	c Objet: Lecture de l'etat initial pour la physique
14	c======================================================================
15	use dimphy
16	IMPLICIT none
17	#include "dimensions.h"
18	#include "netcdf.inc"
19	#include "dimsoil.h"
20	#include "temps.h"
21	c======================================================================
22	CHARACTER() fichnom
23	REAL rlat(klon), rlon(klon)
24	REAL tsol(klon)
25	REAL tsoil(klon,nsoilmx)
26	REAL albe(klon)
27	cIM BEG alblw
28	REAL alblw(klon)
29	cIM END alblw
30	REAL radsol(klon)
31	REAL sollw(klon)
32	real solsw(klon)
33	real fder(klon)
34	INTEGER length
35	PARAMETER (length=100)
36	REAL tabcntr0(length)
37
38	REAL xmin, xmax
39	c
40	INTEGER nid, nvarid
41	INTEGER ierr, i, nsrf, isoil
42	CHARACTER*2 str2
43	c
44	c Ouvrir le fichier contenant l'etat initial:
45	c
46	print*,'fichnom',fichnom
47	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
48	IF (ierr.NE.NF_NOERR) THEN
49	write(6,*)' Pb d''ouverture du fichier '//fichnom
50	write(6,*)' ierr = ', ierr
51	CALL ABORT
52	ENDIF
53	c
54	c Lecture des parametres de controle:
55	c
56	ierr = NF_INQ_VARID (nid, "controle", nvarid)
57	IF (ierr.NE.NF_NOERR) THEN
58	PRINT*, 'phyetat0: Le champ <controle> est absent'
59	CALL abort
60	ENDIF
61	#ifdef NC_DOUBLE
62	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tabcntr0)
63	#else
64	ierr = NF_GET_VAR_REAL(nid, nvarid, tabcntr0)
65	#endif
66	IF (ierr.NE.NF_NOERR) THEN
67	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
68	CALL abort
69	ENDIF
70	c
71	c
72	c Lecture des latitudes (coordonnees):
73	c
74	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
75	IF (ierr.NE.NF_NOERR) THEN
76	PRINT*, 'phyetat0: Le champ <latitude> est absent'
77	CALL abort
78	ENDIF
79	#ifdef NC_DOUBLE
80	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
81	#else
82	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
83	#endif
84	IF (ierr.NE.NF_NOERR) THEN
85	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
86	CALL abort
87	ENDIF
88	c
89	c Lecture des longitudes (coordonnees):
90	c
91	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
92	IF (ierr.NE.NF_NOERR) THEN
93	PRINT*, 'phyetat0: Le champ <longitude> est absent'
94	CALL abort
95	ENDIF
96	#ifdef NC_DOUBLE
97	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
98	#else
99	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
100	#endif
101	IF (ierr.NE.NF_NOERR) THEN
102	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
103	CALL abort
104	ENDIF
105	C
106	c Lecture des temperatures du sol:
107	c
108	ierr = NF_INQ_VARID (nid, "TS", nvarid)
109	IF (ierr.NE.NF_NOERR) THEN
110	PRINT*, 'phyetat0: Le champ <TS> est absent'
111	PRINT*, "phyetat0: Lecture echouee pour <TS>"
112	CALL abort
113	ELSE
114	PRINT*, 'phyetat0: Le champ <TS> est present'
115	#ifdef NC_DOUBLE
116	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
117	#else
118	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
119	#endif
120	IF (ierr.NE.NF_NOERR) THEN
121	PRINT*, "phyetat0: Lecture echouee pour <TS>"
122	CALL abort
123	ENDIF
124	xmin = 1.0E+20
125	xmax = -1.0E+20
126	DO i = 1, klon
127	xmin = MIN(tsol(i),xmin)
128	xmax = MAX(tsol(i),xmax)
129	ENDDO
130	PRINT*,'Temperature du sol <TS>', xmin, xmax
131	ENDIF
132	c
133	c Lecture des temperatures du sol profond:
134	c
135	DO isoil=1, nsoilmx
136	IF (isoil.GT.99) THEN
137	PRINT*, "Trop de couches"
138	CALL abort
139	ENDIF
140	WRITE(str2,'(i2.2)') isoil
141	ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
142	IF (ierr.NE.NF_NOERR) THEN
143	PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
144	PRINT*, " Il prend donc la valeur de surface"
145	DO i=1, klon
146	tsoil(i,isoil)=tsol(i)
147	ENDDO
148	ELSE
149	#ifdef NC_DOUBLE
150	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
151	#else
152	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
153	#endif
154	IF (ierr.NE.NF_NOERR) THEN
155	PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
156	CALL abort
157	ENDIF
158	ENDIF
159	ENDDO
160	c
161	c Lecture de albedo au sol:
162	c
163	ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
164	IF (ierr.NE.NF_NOERR) THEN
165	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
166	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
167	CALL abort
168	ELSE
169	PRINT*, 'phyetat0: Le champ <ALBE> est present'
170	#ifdef NC_DOUBLE
171	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
172	#else
173	ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
174	#endif
175	IF (ierr.NE.NF_NOERR) THEN
176	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
177	CALL abort
178	ENDIF
179	xmin = 1.0E+20
180	xmax = -1.0E+20
181	DO i = 1, klon
182	xmin = MIN(albe(i),xmin)
183	xmax = MAX(albe(i),xmax)
184	ENDDO
185	PRINT*,'Albedo du sol <ALBE>', xmin, xmax
186	ENDIF
187
188	c
189	c Lecture rayonnement solaire au sol:
190	c
191	ierr = NF_INQ_VARID (nid, "solsw", nvarid)
192	IF (ierr.NE.NF_NOERR) THEN
193	PRINT*, 'phyetat0: Le champ <solsw> est absent'
194	PRINT*, 'mis a zero'
195	solsw = 0.
196	ELSE
197	#ifdef NC_DOUBLE
198	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
199	#else
200	ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
201	#endif
202	IF (ierr.NE.NF_NOERR) THEN
203	PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
204	CALL abort
205	ENDIF
206	ENDIF
207	xmin = 1.0E+20
208	xmax = -1.0E+20
209	DO i = 1, klon
210	xmin = MIN(solsw(i),xmin)
211	xmax = MAX(solsw(i),xmax)
212	ENDDO
213	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
214	c
215	c Lecture rayonnement IF au sol:
216	c
217	ierr = NF_INQ_VARID (nid, "sollw", nvarid)
218	IF (ierr.NE.NF_NOERR) THEN
219	PRINT*, 'phyetat0: Le champ <sollw> est absent'
220	PRINT*, 'mis a zero'
221	sollw = 0.
222	ELSE
223	#ifdef NC_DOUBLE
224	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
225	#else
226	ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
227	#endif
228	IF (ierr.NE.NF_NOERR) THEN
229	PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
230	CALL abort
231	ENDIF
232	ENDIF
233	xmin = 1.0E+20
234	xmax = -1.0E+20
235	DO i = 1, klon
236	xmin = MIN(sollw(i),xmin)
237	xmax = MAX(sollw(i),xmax)
238	ENDDO
239	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
240
241	c
242	c Lecture derive des flux:
243	c
244	ierr = NF_INQ_VARID (nid, "fder", nvarid)
245	IF (ierr.NE.NF_NOERR) THEN
246	PRINT*, 'phyetat0: Le champ <fder> est absent'
247	PRINT*, 'mis a zero'
248	fder = 0.
249	ELSE
250	#ifdef NC_DOUBLE
251	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
252	#else
253	ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
254	#endif
255	IF (ierr.NE.NF_NOERR) THEN
256	PRINT*, 'phyetat0: Lecture echouee pour <fder>'
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(fder(i),xmin)
264	xmax = MAX(fder(i),xmax)
265	ENDDO
266	PRINT*,'Derive des flux fder:', xmin, xmax
267
268	c
269	c Lecture du rayonnement net au sol:
270	c
271	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
272	IF (ierr.NE.NF_NOERR) THEN
273	PRINT*, 'phyetat0: Le champ <RADS> est absent'
274	CALL abort
275	ENDIF
276	#ifdef NC_DOUBLE
277	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
278	#else
279	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
280	#endif
281	IF (ierr.NE.NF_NOERR) THEN
282	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
283	CALL abort
284	ENDIF
285	xmin = 1.0E+20
286	xmax = -1.0E+20
287	DO i = 1, klon
288	xmin = MIN(radsol(i),xmin)
289	xmax = MAX(radsol(i),xmax)
290	ENDDO
291	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
292	c
293	c Fermer le fichier:
294	c
295	ierr = NF_CLOSE(nid)
296	c
297	RETURN
298	END

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

Download in other formats:

Original Format