Context Navigation

dynetat0.F @ 319

Last change on this file since 319 was 232, checked in by lmdzadmin, 23 years ago
Merge par rapport a la branche principale LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 10.5 KB

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