Context Navigation

dynetat0_loc.F @ 1707

Last change on this file since 1707 was 1707, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1706

Testing release based on r1706

File size: 12.7 KB

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

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

Download in other formats:

Original Format