Context Navigation

dynetat0.F @ 1640

Last change on this file since 1640 was 1114, checked in by jghattas, 16 years ago

Creation du module infotrac:

contient les variables de advtrac.h
contient la subroutine iniadvtrac renommer en infotrac_init
le nombre des traceurs est lu dans tracer.def en dynamique (ou par default ou recu par INCA)
ce module est utilise dans la dynamique et la physique
contient aussi la variable nbtr qui avant etait stockee dans dimphy

Le fichier advtrac.h n'existe plus.
La compilation ne prend plus en compte le nombre de traceur.

/JG

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 10.4 KB

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

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

Download in other formats:

Original Format