Context Navigation

phyetat0.F @ 881

Last change on this file since 881 was 815, checked in by slebonnois, 12 years ago
SL: petites modifs Titan et Venus pour tableau controle dans la physique ; pour Titan, petits details lies a raz_date ; modif chemin ioipsl sur gnome ; + elimination d'un warning etrange dans gcm.F
File size: 10.8 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,resch4,
10	. t_ancien,ancien_ok)
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	use control_mod
17	IMPLICIT none
18	#include "dimensions.h"
19	#include "netcdf.inc"
20	#include "dimsoil.h"
21	#include "clesphys.h"
22	#include "tabcontrol.h"
23	#include "temps.h"
24	c======================================================================
25	CHARACTER() fichnom
26	REAL rlat(klon), rlon(klon) ! in degrees
27	REAL tsol(klon)
28	REAL tsoil(klon,nsoilmx)
29	REAL albe(klon)
30	cIM BEG alblw
31	REAL alblw(klon)
32	cIM END alblw
33	REAL radsol(klon)
34	REAL sollw(klon)
35	real solsw(klon)
36	real fder(klon)
37
38	REAL t_ancien(klon,klev)
39	LOGICAL ancien_ok
40
41	REAL resch4(klon)
42	INTEGER ig0
43
44	REAL xmin, xmax
45	c
46	INTEGER nid, nvarid
47	INTEGER ierr, i, nsrf, isoil
48	REAL tab_cntrl(length)
49	CHARACTER*2 str2
50	c
51	c Ouvrir le fichier contenant l'etat initial:
52	c
53	print*,'fichnom',fichnom
54	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
55	IF (ierr.NE.NF_NOERR) THEN
56	write(6,*)' Pb d''ouverture du fichier '//fichnom
57	write(6,*)' ierr = ', ierr
58	CALL ABORT
59	ENDIF
60	c
61	c Lecture des parametres de controle:
62	c
63	ierr = NF_INQ_VARID (nid, "controle", nvarid)
64	IF (ierr.NE.NF_NOERR) THEN
65	PRINT*, 'phyetat0: Le champ <controle> est absent'
66	CALL abort
67	ENDIF
68	#ifdef NC_DOUBLE
69	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
70	#else
71	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
72	#endif
73	IF (ierr.NE.NF_NOERR) THEN
74	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
75	CALL abort
76	ELSE
77	c
78	DO i = 1, length
79	tabcntr0( i ) = tab_cntrl( i )
80	ENDDO
81	c
82
83	dtime = tab_cntrl(1)
84	radpas = tab_cntrl(2)
85	chimpas = tab_cntrl(3)
86	lsinit = tab_cntrl(17)
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	c et verifier que lsinit est proche de 0.
95	IF (raz_date.eq.1) THEN
96	itau_phy=0
97	if ((lsinit.gt.3.).and.(lsinit.lt.357.)) then
98	PRINT*, 'phyetat0: raz_date=1 and ls different from 0.'
99	PRINT*, 'When raz_date=1, we reset the initial date'
100	PRINT*, 'to spring equinox, Ls=0., so the start files'
101	PRINT*, 'should be within a couple of degrees from Ls=0.'
102	PRINT*, 'or the circulation will be too far from equilibrium'
103	CALL abort
104	endif
105	ENDIF
106
107	c
108	c Lecture des latitudes (coordonnees):
109	c
110	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
111	IF (ierr.NE.NF_NOERR) THEN
112	PRINT*, 'phyetat0: Le champ <latitude> est absent'
113	CALL abort
114	ENDIF
115	#ifdef NC_DOUBLE
116	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
117	#else
118	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
119	#endif
120	IF (ierr.NE.NF_NOERR) THEN
121	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
122	CALL abort
123	ENDIF
124	c
125	c Lecture des longitudes (coordonnees):
126	c
127	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
128	IF (ierr.NE.NF_NOERR) THEN
129	PRINT*, 'phyetat0: Le champ <longitude> est absent'
130	CALL abort
131	ENDIF
132	#ifdef NC_DOUBLE
133	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
134	#else
135	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
136	#endif
137	IF (ierr.NE.NF_NOERR) THEN
138	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
139	CALL abort
140	ENDIF
141	C
142	c Lecture des temperatures du sol:
143	c
144	ierr = NF_INQ_VARID (nid, "TS", nvarid)
145	IF (ierr.NE.NF_NOERR) THEN
146	PRINT*, 'phyetat0: Le champ <TS> est absent'
147	PRINT*, "phyetat0: Lecture echouee pour <TS>"
148	CALL abort
149	ELSE
150	PRINT*, 'phyetat0: Le champ <TS> est present'
151	#ifdef NC_DOUBLE
152	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
153	#else
154	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
155	#endif
156	IF (ierr.NE.NF_NOERR) THEN
157	PRINT*, "phyetat0: Lecture echouee pour <TS>"
158	CALL abort
159	ENDIF
160	xmin = 1.0E+20
161	xmax = -1.0E+20
162	DO i = 1, klon
163	xmin = MIN(tsol(i),xmin)
164	xmax = MAX(tsol(i),xmax)
165	ENDDO
166	PRINT*,'Temperature du sol <TS>', xmin, xmax
167	ENDIF
168	c
169	c Lecture des temperatures du sol profond:
170	c
171	DO isoil=1, nsoilmx
172	IF (isoil.GT.99) THEN
173	PRINT*, "Trop de couches"
174	CALL abort
175	ENDIF
176	WRITE(str2,'(i2.2)') isoil
177	ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
178	IF (ierr.NE.NF_NOERR) THEN
179	PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
180	PRINT*, " Il prend donc la valeur de surface"
181	DO i=1, klon
182	tsoil(i,isoil)=tsol(i)
183	ENDDO
184	ELSE
185	#ifdef NC_DOUBLE
186	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
187	#else
188	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
189	#endif
190	IF (ierr.NE.NF_NOERR) THEN
191	PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
192	CALL abort
193	ENDIF
194	ENDIF
195	ENDDO
196	c
197	c Lecture de albedo au sol:
198	c
199	ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
200	IF (ierr.NE.NF_NOERR) THEN
201	PRINT*, 'phyetat0: Le champ <ALBE> est absent'
202	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
203	CALL abort
204	ELSE
205	PRINT*, 'phyetat0: Le champ <ALBE> est present'
206	#ifdef NC_DOUBLE
207	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
208	#else
209	ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
210	#endif
211	IF (ierr.NE.NF_NOERR) THEN
212	PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
213	CALL abort
214	ENDIF
215	xmin = 1.0E+20
216	xmax = -1.0E+20
217	DO i = 1, klon
218	xmin = MIN(albe(i),xmin)
219	xmax = MAX(albe(i),xmax)
220	ENDDO
221	PRINT*,'Albedo du sol <ALBE>', xmin, xmax
222	ENDIF
223
224	c
225	c Lecture rayonnement solaire au sol:
226	c
227	ierr = NF_INQ_VARID (nid, "solsw", nvarid)
228	IF (ierr.NE.NF_NOERR) THEN
229	PRINT*, 'phyetat0: Le champ <solsw> est absent'
230	PRINT*, 'mis a zero'
231	solsw = 0.
232	ELSE
233	#ifdef NC_DOUBLE
234	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
235	#else
236	ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
237	#endif
238	IF (ierr.NE.NF_NOERR) THEN
239	PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
240	CALL abort
241	ENDIF
242	ENDIF
243	xmin = 1.0E+20
244	xmax = -1.0E+20
245	DO i = 1, klon
246	xmin = MIN(solsw(i),xmin)
247	xmax = MAX(solsw(i),xmax)
248	ENDDO
249	PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
250	c
251	c Lecture rayonnement IF au sol:
252	c
253	ierr = NF_INQ_VARID (nid, "sollw", nvarid)
254	IF (ierr.NE.NF_NOERR) THEN
255	PRINT*, 'phyetat0: Le champ <sollw> est absent'
256	PRINT*, 'mis a zero'
257	sollw = 0.
258	ELSE
259	#ifdef NC_DOUBLE
260	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
261	#else
262	ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
263	#endif
264	IF (ierr.NE.NF_NOERR) THEN
265	PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
266	CALL abort
267	ENDIF
268	ENDIF
269	xmin = 1.0E+20
270	xmax = -1.0E+20
271	DO i = 1, klon
272	xmin = MIN(sollw(i),xmin)
273	xmax = MAX(sollw(i),xmax)
274	ENDDO
275	PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
276
277	c
278	c Lecture derive des flux:
279	c
280	ierr = NF_INQ_VARID (nid, "fder", nvarid)
281	IF (ierr.NE.NF_NOERR) THEN
282	PRINT*, 'phyetat0: Le champ <fder> est absent'
283	PRINT*, 'mis a zero'
284	fder = 0.
285	ELSE
286	#ifdef NC_DOUBLE
287	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
288	#else
289	ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
290	#endif
291	IF (ierr.NE.NF_NOERR) THEN
292	PRINT*, 'phyetat0: Lecture echouee pour <fder>'
293	CALL abort
294	ENDIF
295	ENDIF
296	xmin = 1.0E+20
297	xmax = -1.0E+20
298	DO i = 1, klon
299	xmin = MIN(fder(i),xmin)
300	xmax = MAX(fder(i),xmax)
301	ENDDO
302	PRINT*,'Derive des flux fder:', xmin, xmax
303
304	c
305	c Lecture du rayonnement net au sol:
306	c
307	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
308	IF (ierr.NE.NF_NOERR) THEN
309	PRINT*, 'phyetat0: Le champ <RADS> est absent'
310	CALL abort
311	ENDIF
312	#ifdef NC_DOUBLE
313	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
314	#else
315	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
316	#endif
317	IF (ierr.NE.NF_NOERR) THEN
318	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
319	CALL abort
320	ENDIF
321	xmin = 1.0E+20
322	xmax = -1.0E+20
323	DO i = 1, klon
324	xmin = MIN(radsol(i),xmin)
325	xmax = MAX(radsol(i),xmax)
326	ENDDO
327	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
328	c
329	ancien_ok = .TRUE.
330	c
331	ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
332	IF (ierr.NE.NF_NOERR) THEN
333	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
334	PRINT*, "Depart legerement fausse. Mais je continue"
335	ancien_ok = .FALSE.
336	ELSE
337	#ifdef NC_DOUBLE
338	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
339	#else
340	ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
341	#endif
342	IF (ierr.NE.NF_NOERR) THEN
343	PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
344	CALL abort
345	ENDIF
346	ENDIF
347	c Par defaut on cree 2 bandes de methane au pole Nord et au pole Sud
348	c (entre 75 et 85 degres de latitude) de 2 metres.
349	c Les poles sont sec !
350	resch4(1) = 0. ! pole nord = 1 point
351	DO ig0=2,klon
352	if ((rlat(ig0).ge.75..and.rlat(ig0).le.85.).or.
353	& (rlat(ig0).ge.-85.and.rlat(ig0).le.-75.)) then
354	resch4(ig0) = 2.
355	else
356	resch4(ig0) = 0.
357	endif
358	ENDDO
359	resch4(klon) = 0. ! pole sud = 1 point
360
361	ierr = NF_INQ_VARID (nid, "RESCH4", nvarid)
362	IF (ierr.NE.NF_NOERR) THEN
363	PRINT*, "phyetat0: Le champ <RESCH4> est absent"
364	PRINT*, "Pas de reservoir de methane mais je continue..."
365	PRINT*, "Pour info, je met 2 metres de methane sur 2 bandes"
366	PRINT*, "comprises entre 75 et 85 degres de latitude dans "
367	PRINT*, "chaque hemisphere."
368	ELSE
369	#ifdef NC_DOUBLE
370	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, resch4)
371	#else
372	ierr = NF_GET_VAR_REAL(nid, nvarid,resch4)
373	#endif
374	IF (ierr.NE.NF_NOERR) THEN
375	PRINT*, "phyetat0: Lecture echouee pour <reservoir>"
376	CALL abort
377	ENDIF
378	ENDIF
379	c
380	c Fermer le fichier:
381	c
382	ierr = NF_CLOSE(nid)
383	c
384	RETURN
385	END

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

Download in other formats:

Original Format