Context Navigation

dynetat0.F @ 1142

Last change on this file since 1142 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
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
37	c Arguments:
38	c ----------
39
40	CHARACTER() fichnom
41	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
42	REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
43	REAL ps(ip1jmp1),phis(ip1jmp1)
44
45	REAL time
46
47	c Variables
48	c
49	INTEGER length,iq
50	PARAMETER (length = 100)
51	REAL tab_cntrl(length) ! tableau des parametres du run
52	INTEGER ierr, nid, nvarid
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_ref = tab_cntrl(4)
85	annee_ref = 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	c dzoomx = tab_cntrl(25)
109	c dzoomy = tab_cntrl(26)
110	c taux = tab_cntrl(28)
111	c tauy = tab_cntrl(29)
112	ELSE
113	fxyhypb = . FALSE .
114	ysinus = . FALSE .
115	IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
116	ENDIF
117
118	day_ini = tab_cntrl(30)
119	itau_dyn = tab_cntrl(31)
120	c .................................................................
121	c
122	c
123	PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
124
125	IF( im.ne.iim ) THEN
126	PRINT 1,im,iim
127	STOP
128	ELSE IF( jm.ne.jjm ) THEN
129	PRINT 2,jm,jjm
130	STOP
131	ELSE IF( lllm.ne.llm ) THEN
132	PRINT 3,lllm,llm
133	STOP
134	ENDIF
135
136	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
137	IF (ierr .NE. NF_NOERR) THEN
138	PRINT*, "dynetat0: Le champ <rlonu> est absent"
139	CALL abort
140	ENDIF
141	#ifdef NC_DOUBLE
142	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
143	#else
144	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
145	#endif
146	IF (ierr .NE. NF_NOERR) THEN
147	PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
148	CALL abort
149	ENDIF
150
151	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
152	IF (ierr .NE. NF_NOERR) THEN
153	PRINT*, "dynetat0: Le champ <rlatu> est absent"
154	CALL abort
155	ENDIF
156	#ifdef NC_DOUBLE
157	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
158	#else
159	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
160	#endif
161	IF (ierr .NE. NF_NOERR) THEN
162	PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
163	CALL abort
164	ENDIF
165
166	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
167	IF (ierr .NE. NF_NOERR) THEN
168	PRINT*, "dynetat0: Le champ <rlonv> est absent"
169	CALL abort
170	ENDIF
171	#ifdef NC_DOUBLE
172	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
173	#else
174	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
175	#endif
176	IF (ierr .NE. NF_NOERR) THEN
177	PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
178	CALL abort
179	ENDIF
180
181	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
182	IF (ierr .NE. NF_NOERR) THEN
183	PRINT*, "dynetat0: Le champ <rlatv> est absent"
184	CALL abort
185	ENDIF
186	#ifdef NC_DOUBLE
187	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
188	#else
189	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
190	#endif
191	IF (ierr .NE. NF_NOERR) THEN
192	PRINT*, "dynetat0: Lecture echouee pour rlatv"
193	CALL abort
194	ENDIF
195
196	ierr = NF_INQ_VARID (nid, "cu", nvarid)
197	IF (ierr .NE. NF_NOERR) THEN
198	PRINT*, "dynetat0: Le champ <cu> est absent"
199	CALL abort
200	ENDIF
201	#ifdef NC_DOUBLE
202	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
203	#else
204	ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
205	#endif
206	IF (ierr .NE. NF_NOERR) THEN
207	PRINT*, "dynetat0: Lecture echouee pour <cu>"
208	CALL abort
209	ENDIF
210
211	ierr = NF_INQ_VARID (nid, "cv", nvarid)
212	IF (ierr .NE. NF_NOERR) THEN
213	PRINT*, "dynetat0: Le champ <cv> est absent"
214	CALL abort
215	ENDIF
216	#ifdef NC_DOUBLE
217	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
218	#else
219	ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
220	#endif
221	IF (ierr .NE. NF_NOERR) THEN
222	PRINT*, "dynetat0: Lecture echouee pour <cv>"
223	CALL abort
224	ENDIF
225
226	ierr = NF_INQ_VARID (nid, "aire", nvarid)
227	IF (ierr .NE. NF_NOERR) THEN
228	PRINT*, "dynetat0: Le champ <aire> est absent"
229	CALL abort
230	ENDIF
231	#ifdef NC_DOUBLE
232	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
233	#else
234	ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
235	#endif
236	IF (ierr .NE. NF_NOERR) THEN
237	PRINT*, "dynetat0: Lecture echouee pour <aire>"
238	CALL abort
239	ENDIF
240
241	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
242	IF (ierr .NE. NF_NOERR) THEN
243	PRINT*, "dynetat0: Le champ <phisinit> est absent"
244	CALL abort
245	ENDIF
246	#ifdef NC_DOUBLE
247	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
248	#else
249	ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
250	#endif
251	IF (ierr .NE. NF_NOERR) THEN
252	PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
253	CALL abort
254	ENDIF
255
256	ierr = NF_INQ_VARID (nid, "temps", nvarid)
257	IF (ierr .NE. NF_NOERR) THEN
258	PRINT*, "dynetat0: Le champ <temps> est absent"
259	CALL abort
260	ENDIF
261	#ifdef NC_DOUBLE
262	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
263	#else
264	ierr = NF_GET_VAR_REAL(nid, nvarid, time)
265	#endif
266	IF (ierr .NE. NF_NOERR) THEN
267	PRINT*, "dynetat0: Lecture echouee <temps>"
268	CALL abort
269	ENDIF
270
271	ierr = NF_INQ_VARID (nid, "ucov", nvarid)
272	IF (ierr .NE. NF_NOERR) THEN
273	PRINT*, "dynetat0: Le champ <ucov> est absent"
274	CALL abort
275	ENDIF
276	#ifdef NC_DOUBLE
277	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
278	#else
279	ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
280	#endif
281	IF (ierr .NE. NF_NOERR) THEN
282	PRINT*, "dynetat0: Lecture echouee pour <ucov>"
283	CALL abort
284	ENDIF
285
286	ierr = NF_INQ_VARID (nid, "vcov", nvarid)
287	IF (ierr .NE. NF_NOERR) THEN
288	PRINT*, "dynetat0: Le champ <vcov> est absent"
289	CALL abort
290	ENDIF
291	#ifdef NC_DOUBLE
292	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
293	#else
294	ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
295	#endif
296	IF (ierr .NE. NF_NOERR) THEN
297	PRINT*, "dynetat0: Lecture echouee pour <vcov>"
298	CALL abort
299	ENDIF
300
301	ierr = NF_INQ_VARID (nid, "teta", nvarid)
302	IF (ierr .NE. NF_NOERR) THEN
303	PRINT*, "dynetat0: Le champ <teta> est absent"
304	CALL abort
305	ENDIF
306	#ifdef NC_DOUBLE
307	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
308	#else
309	ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
310	#endif
311	IF (ierr .NE. NF_NOERR) THEN
312	PRINT*, "dynetat0: Lecture echouee pour <teta>"
313	CALL abort
314	ENDIF
315
316
317	IF(nqtot.GE.1) THEN
318	DO iq=1,nqtot
319	ierr = NF_INQ_VARID (nid, tname(iq), nvarid)
320	IF (ierr .NE. NF_NOERR) THEN
321	PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
322	PRINT*, " Il est donc initialise a zero"
323	q(:,:,iq)=0.
324	ELSE
325	#ifdef NC_DOUBLE
326	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
327	#else
328	ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
329	#endif
330	IF (ierr .NE. NF_NOERR) THEN
331	PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
332	CALL abort
333	ENDIF
334	ENDIF
335	ENDDO
336	ENDIF
337
338	ierr = NF_INQ_VARID (nid, "masse", nvarid)
339	IF (ierr .NE. NF_NOERR) THEN
340	PRINT*, "dynetat0: Le champ <masse> est absent"
341	CALL abort
342	ENDIF
343	#ifdef NC_DOUBLE
344	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
345	#else
346	ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
347	#endif
348	IF (ierr .NE. NF_NOERR) THEN
349	PRINT*, "dynetat0: Lecture echouee pour <masse>"
350	CALL abort
351	ENDIF
352
353	ierr = NF_INQ_VARID (nid, "ps", nvarid)
354	IF (ierr .NE. NF_NOERR) THEN
355	PRINT*, "dynetat0: Le champ <ps> est absent"
356	CALL abort
357	ENDIF
358	#ifdef NC_DOUBLE
359	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
360	#else
361	ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
362	#endif
363	IF (ierr .NE. NF_NOERR) THEN
364	PRINT*, "dynetat0: Lecture echouee pour <ps>"
365	CALL abort
366	ENDIF
367
368	ierr = NF_CLOSE(nid)
369
370	day_ini=day_ini+INT(time)
371	time=time-INT(time)
372
373	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
374	*arrage est differente de la valeur parametree iim =',i4//)
375	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
376	*arrage est differente de la valeur parametree jjm =',i4//)
377	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
378	*rrage est differente de la valeur parametree llm =',i4//)
379	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
380	*rrage est differente de la valeur dtinteg =',i4//)
381
382	RETURN
383	END

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

Download in other formats:

Original Format