Context Navigation

readstartphy.F @ 881

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

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

Download in other formats:

Original Format