Context Navigation

dynetat0.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago
Import initial LMDZ5
File size: 10.8 KB

Line
1	!
2	! $Id $
3	!
4	SUBROUTINE dynetat0(fichnom,vcov,ucov,
5	. teta,q,masse,ps,phis,time)
6
7	USE infotrac
8	IMPLICIT NONE
9
10	c=======================================================================
11	c
12	c Auteur: P. Le Van / L.Fairhead
13	c -------
14	c
15	c objet:
16	c ------
17	c
18	c Lecture de l'etat initial
19	c
20	c=======================================================================
21	c-----------------------------------------------------------------------
22	c Declarations:
23	c -------------
24
25	#include "dimensions.h"
26	#include "paramet.h"
27	#include "temps.h"
28	#include "comconst.h"
29	#include "comvert.h"
30	#include "comgeom.h"
31	#include "ener.h"
32	#include "netcdf.inc"
33	#include "description.h"
34	#include "serre.h"
35	#include "logic.h"
36	#include "iniprint.h"
37
38	c Arguments:
39	c ----------
40
41	CHARACTER() fichnom
42	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
43	REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
44	REAL ps(ip1jmp1),phis(ip1jmp1)
45
46	REAL time
47
48	c Variables
49	c
50	INTEGER length,iq
51	PARAMETER (length = 100)
52	REAL tab_cntrl(length) ! tableau des parametres du run
53	INTEGER ierr, nid, nvarid
54
55	c-----------------------------------------------------------------------
56
57	c Ouverture NetCDF du fichier etat initial
58
59	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
60	IF (ierr.NE.NF_NOERR) THEN
61	write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
62	write(lunout,*)' ierr = ', ierr
63	CALL ABORT
64	ENDIF
65
66	c
67	ierr = NF_INQ_VARID (nid, "controle", nvarid)
68	IF (ierr .NE. NF_NOERR) THEN
69	write(lunout,*)"dynetat0: Le champ <controle> est absent"
70	CALL abort
71	ENDIF
72	#ifdef NC_DOUBLE
73	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
74	#else
75	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
76	#endif
77	IF (ierr .NE. NF_NOERR) THEN
78	write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
79	CALL abort
80	ENDIF
81
82	im = tab_cntrl(1)
83	jm = tab_cntrl(2)
84	lllm = tab_cntrl(3)
85	day_ref = tab_cntrl(4)
86	annee_ref = tab_cntrl(5)
87	rad = tab_cntrl(6)
88	omeg = tab_cntrl(7)
89	g = tab_cntrl(8)
90	cpp = tab_cntrl(9)
91	kappa = tab_cntrl(10)
92	daysec = tab_cntrl(11)
93	dtvr = tab_cntrl(12)
94	etot0 = tab_cntrl(13)
95	ptot0 = tab_cntrl(14)
96	ztot0 = tab_cntrl(15)
97	stot0 = tab_cntrl(16)
98	ang0 = tab_cntrl(17)
99	pa = tab_cntrl(18)
100	preff = tab_cntrl(19)
101	c
102	clon = tab_cntrl(20)
103	clat = tab_cntrl(21)
104	grossismx = tab_cntrl(22)
105	grossismy = tab_cntrl(23)
106	c
107	IF ( tab_cntrl(24).EQ.1. ) THEN
108	fxyhypb = . TRUE .
109	c dzoomx = tab_cntrl(25)
110	c dzoomy = tab_cntrl(26)
111	c taux = tab_cntrl(28)
112	c tauy = tab_cntrl(29)
113	ELSE
114	fxyhypb = . FALSE .
115	ysinus = . FALSE .
116	IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
117	ENDIF
118
119	day_ini = tab_cntrl(30)
120	itau_dyn = tab_cntrl(31)
121	c .................................................................
122	c
123	c
124	write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
125	& rad,omeg,g,cpp,kappa
126
127	IF( im.ne.iim ) THEN
128	PRINT 1,im,iim
129	STOP
130	ELSE IF( jm.ne.jjm ) THEN
131	PRINT 2,jm,jjm
132	STOP
133	ELSE IF( lllm.ne.llm ) THEN
134	PRINT 3,lllm,llm
135	STOP
136	ENDIF
137
138	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
139	IF (ierr .NE. NF_NOERR) THEN
140	write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
141	CALL abort
142	ENDIF
143	#ifdef NC_DOUBLE
144	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
145	#else
146	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
147	#endif
148	IF (ierr .NE. NF_NOERR) THEN
149	write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
150	CALL abort
151	ENDIF
152
153	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
154	IF (ierr .NE. NF_NOERR) THEN
155	write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
156	CALL abort
157	ENDIF
158	#ifdef NC_DOUBLE
159	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
160	#else
161	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
162	#endif
163	IF (ierr .NE. NF_NOERR) THEN
164	write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
165	CALL abort
166	ENDIF
167
168	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
169	IF (ierr .NE. NF_NOERR) THEN
170	write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
171	CALL abort
172	ENDIF
173	#ifdef NC_DOUBLE
174	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
175	#else
176	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
177	#endif
178	IF (ierr .NE. NF_NOERR) THEN
179	write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
180	CALL abort
181	ENDIF
182
183	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
184	IF (ierr .NE. NF_NOERR) THEN
185	write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
186	CALL abort
187	ENDIF
188	#ifdef NC_DOUBLE
189	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
190	#else
191	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
192	#endif
193	IF (ierr .NE. NF_NOERR) THEN
194	write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
195	CALL abort
196	ENDIF
197
198	ierr = NF_INQ_VARID (nid, "cu", nvarid)
199	IF (ierr .NE. NF_NOERR) THEN
200	write(lunout,*)"dynetat0: Le champ <cu> est absent"
201	CALL abort
202	ENDIF
203	#ifdef NC_DOUBLE
204	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
205	#else
206	ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
207	#endif
208	IF (ierr .NE. NF_NOERR) THEN
209	write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
210	CALL abort
211	ENDIF
212
213	ierr = NF_INQ_VARID (nid, "cv", nvarid)
214	IF (ierr .NE. NF_NOERR) THEN
215	write(lunout,*)"dynetat0: Le champ <cv> est absent"
216	CALL abort
217	ENDIF
218	#ifdef NC_DOUBLE
219	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
220	#else
221	ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
222	#endif
223	IF (ierr .NE. NF_NOERR) THEN
224	write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
225	CALL abort
226	ENDIF
227
228	ierr = NF_INQ_VARID (nid, "aire", nvarid)
229	IF (ierr .NE. NF_NOERR) THEN
230	write(lunout,*)"dynetat0: Le champ <aire> est absent"
231	CALL abort
232	ENDIF
233	#ifdef NC_DOUBLE
234	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
235	#else
236	ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
237	#endif
238	IF (ierr .NE. NF_NOERR) THEN
239	write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
240	CALL abort
241	ENDIF
242
243	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
244	IF (ierr .NE. NF_NOERR) THEN
245	write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
246	CALL abort
247	ENDIF
248	#ifdef NC_DOUBLE
249	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
250	#else
251	ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
252	#endif
253	IF (ierr .NE. NF_NOERR) THEN
254	write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
255	CALL abort
256	ENDIF
257
258	ierr = NF_INQ_VARID (nid, "temps", nvarid)
259	IF (ierr .NE. NF_NOERR) THEN
260	write(lunout,*)"dynetat0: Le champ <temps> est absent"
261	CALL abort
262	ENDIF
263	#ifdef NC_DOUBLE
264	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
265	#else
266	ierr = NF_GET_VAR_REAL(nid, nvarid, time)
267	#endif
268	IF (ierr .NE. NF_NOERR) THEN
269	write(lunout,*)"dynetat0: Lecture echouee <temps>"
270	CALL abort
271	ENDIF
272
273	ierr = NF_INQ_VARID (nid, "ucov", nvarid)
274	IF (ierr .NE. NF_NOERR) THEN
275	write(lunout,*)"dynetat0: Le champ <ucov> est absent"
276	CALL abort
277	ENDIF
278	#ifdef NC_DOUBLE
279	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
280	#else
281	ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
282	#endif
283	IF (ierr .NE. NF_NOERR) THEN
284	write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
285	CALL abort
286	ENDIF
287
288	ierr = NF_INQ_VARID (nid, "vcov", nvarid)
289	IF (ierr .NE. NF_NOERR) THEN
290	write(lunout,*)"dynetat0: Le champ <vcov> est absent"
291	CALL abort
292	ENDIF
293	#ifdef NC_DOUBLE
294	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
295	#else
296	ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
297	#endif
298	IF (ierr .NE. NF_NOERR) THEN
299	write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
300	CALL abort
301	ENDIF
302
303	ierr = NF_INQ_VARID (nid, "teta", nvarid)
304	IF (ierr .NE. NF_NOERR) THEN
305	write(lunout,*)"dynetat0: Le champ <teta> est absent"
306	CALL abort
307	ENDIF
308	#ifdef NC_DOUBLE
309	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
310	#else
311	ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
312	#endif
313	IF (ierr .NE. NF_NOERR) THEN
314	write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
315	CALL abort
316	ENDIF
317
318
319	IF(nqtot.GE.1) THEN
320	DO iq=1,nqtot
321	ierr = NF_INQ_VARID (nid, tname(iq), nvarid)
322	IF (ierr .NE. NF_NOERR) THEN
323	write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
324	& "> est absent"
325	write(lunout,*)" Il est donc initialise a zero"
326	q(:,:,iq)=0.
327	ELSE
328	#ifdef NC_DOUBLE
329	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
330	#else
331	ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
332	#endif
333	IF (ierr .NE. NF_NOERR) THEN
334	write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
335	CALL abort
336	ENDIF
337	ENDIF
338	ENDDO
339	ENDIF
340
341	ierr = NF_INQ_VARID (nid, "masse", nvarid)
342	IF (ierr .NE. NF_NOERR) THEN
343	write(lunout,*)"dynetat0: Le champ <masse> est absent"
344	CALL abort
345	ENDIF
346	#ifdef NC_DOUBLE
347	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
348	#else
349	ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
350	#endif
351	IF (ierr .NE. NF_NOERR) THEN
352	write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
353	CALL abort
354	ENDIF
355
356	ierr = NF_INQ_VARID (nid, "ps", nvarid)
357	IF (ierr .NE. NF_NOERR) THEN
358	write(lunout,*)"dynetat0: Le champ <ps> est absent"
359	CALL abort
360	ENDIF
361	#ifdef NC_DOUBLE
362	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
363	#else
364	ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
365	#endif
366	IF (ierr .NE. NF_NOERR) THEN
367	write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
368	CALL abort
369	ENDIF
370
371	ierr = NF_CLOSE(nid)
372
373	day_ini=day_ini+INT(time)
374	time=time-INT(time)
375
376	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
377	*arrage est differente de la valeur parametree iim =',i4//)
378	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
379	*arrage est differente de la valeur parametree jjm =',i4//)
380	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
381	*rrage est differente de la valeur parametree llm =',i4//)
382	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
383	*rrage est differente de la valeur dtinteg =',i4//)
384
385	RETURN
386	END

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

Download in other formats:

Original Format