Context Navigation

dynetat0.F @ 115

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

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

Download in other formats:

Original Format