Context Navigation

dynetat0.F @ 162

Last change on this file since 162 was 135, checked in by aslmd, 14 years ago
CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET
File size: 12.4 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 Modifs: Oct.2008 read in tracers by name. Ehouarn Millour
16	c
17	c=======================================================================
18	c-----------------------------------------------------------------------
19	c Declarations:
20	c -------------
21
22	#include "dimensions.h"
23	#include "paramet.h"
24	#include "temps.h"
25	#include "comconst.h"
26	#include "comvert.h"
27	#include "comgeom.h"
28	#include "ener.h"
29	#include "netcdf.inc"
30	#include "description.h"
31	#include "serre.h"
32	#include "logic.h"
33	#include"advtrac.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(iip1,jjp1,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,i,j,l
49	PARAMETER (length = 100)
50	REAL tab_cntrl(length) ! tableau des parametres du run
51	INTEGER ierr, nid, nvarid, nqold
52	CHARACTER str33,yes1
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 ',fichnom
61	CALL ABORT
62	ENDIF
63
64	c
65	ierr = NF_INQ_VARID (nid, "controle", nvarid)
66	IF (ierr .NE. NF_NOERR) THEN
67	PRINT*, "dynetat0: Le champ <controle> est absent"
68	CALL abort
69	ENDIF
70	#ifdef NC_DOUBLE
71	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
72	#else
73	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
74	#endif
75	IF (ierr .NE. NF_NOERR) THEN
76	PRINT*, "dynetat0: Lecture echoue pour <controle>"
77	CALL abort
78	ENDIF
79
80	im = tab_cntrl(1)
81	jm = tab_cntrl(2)
82	lllm = tab_cntrl(3)
83	day_ini = tab_cntrl(4)
84	rad = tab_cntrl(5)
85	omeg = tab_cntrl(6)
86	g = tab_cntrl(7)
87	cpp = tab_cntrl(8)
88	kappa = tab_cntrl(9)
89	daysec = tab_cntrl(10)
90	dtvr = tab_cntrl(11)
91	etot0 = tab_cntrl(12)
92	ptot0 = tab_cntrl(13)
93	ztot0 = tab_cntrl(14)
94	stot0 = tab_cntrl(15)
95	ang0 = tab_cntrl(16)
96	pa = tab_cntrl(17)
97	preff = tab_cntrl(18)
98	c
99	clon = tab_cntrl(19)
100	clat = tab_cntrl(20)
101	grossismx = tab_cntrl(21)
102	grossismy = tab_cntrl(22)
103	c
104	IF ( tab_cntrl(23).EQ.1. ) THEN
105	fxyhypb = . TRUE .
106	dzoomx = tab_cntrl(24)
107	dzoomy = tab_cntrl(25)
108	taux = tab_cntrl(27)
109	tauy = tab_cntrl(28)
110	ELSE
111	fxyhypb = . FALSE .
112	ysinus = . FALSE .
113	IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE.
114	ENDIF
115	c .................................................................
116	c
117	c
118	PRINT*,'dynetat0: rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
119
120	IF( im.ne.iim ) THEN
121	PRINT 1,im,iim
122	STOP
123	ELSE IF( jm.ne.jjm ) THEN
124	PRINT 2,jm,jjm
125	STOP
126	ELSE IF( lllm.ne.llm ) THEN
127	PRINT 3,lllm,llm
128	STOP
129	ENDIF
130
131	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
132	IF (ierr .NE. NF_NOERR) THEN
133	PRINT*, "dynetat0: Le champ <rlonu> est absent"
134	CALL abort
135	ENDIF
136	#ifdef NC_DOUBLE
137	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
138	#else
139	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
140	#endif
141	IF (ierr .NE. NF_NOERR) THEN
142	PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
143	CALL abort
144	ENDIF
145
146	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
147	IF (ierr .NE. NF_NOERR) THEN
148	PRINT*, "dynetat0: Le champ <rlatu> est absent"
149	CALL abort
150	ENDIF
151	#ifdef NC_DOUBLE
152	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
153	#else
154	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
155	#endif
156	IF (ierr .NE. NF_NOERR) THEN
157	PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
158	CALL abort
159	ENDIF
160
161	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
162	IF (ierr .NE. NF_NOERR) THEN
163	PRINT*, "dynetat0: Le champ <rlonv> est absent"
164	CALL abort
165	ENDIF
166	#ifdef NC_DOUBLE
167	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
168	#else
169	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
170	#endif
171	IF (ierr .NE. NF_NOERR) THEN
172	PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
173	CALL abort
174	ENDIF
175
176	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
177	IF (ierr .NE. NF_NOERR) THEN
178	PRINT*, "dynetat0: Le champ <rlatv> est absent"
179	CALL abort
180	ENDIF
181	#ifdef NC_DOUBLE
182	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
183	#else
184	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
185	#endif
186	IF (ierr .NE. NF_NOERR) THEN
187	PRINT*, "dynetat0: Lecture echouee pour rlatv"
188	CALL abort
189	ENDIF
190
191	ierr = NF_INQ_VARID (nid, "cu", nvarid)
192	IF (ierr .NE. NF_NOERR) THEN
193	PRINT*, "dynetat0: Le champ <cu> est absent"
194	CALL abort
195	ENDIF
196	#ifdef NC_DOUBLE
197	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
198	#else
199	ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
200	#endif
201	IF (ierr .NE. NF_NOERR) THEN
202	PRINT*, "dynetat0: Lecture echouee pour <cu>"
203	CALL abort
204	ENDIF
205
206	ierr = NF_INQ_VARID (nid, "cv", nvarid)
207	IF (ierr .NE. NF_NOERR) THEN
208	PRINT*, "dynetat0: Le champ <cv> est absent"
209	CALL abort
210	ENDIF
211	#ifdef NC_DOUBLE
212	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
213	#else
214	ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
215	#endif
216	IF (ierr .NE. NF_NOERR) THEN
217	PRINT*, "dynetat0: Lecture echouee pour <cv>"
218	CALL abort
219	ENDIF
220
221	ierr = NF_INQ_VARID (nid, "aire", nvarid)
222	IF (ierr .NE. NF_NOERR) THEN
223	PRINT*, "dynetat0: Le champ <aire> est absent"
224	CALL abort
225	ENDIF
226	#ifdef NC_DOUBLE
227	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
228	#else
229	ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
230	#endif
231	IF (ierr .NE. NF_NOERR) THEN
232	PRINT*, "dynetat0: Lecture echouee pour <aire>"
233	CALL abort
234	ENDIF
235
236	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
237	IF (ierr .NE. NF_NOERR) THEN
238	PRINT*, "dynetat0: Le champ <phisinit> est absent"
239	CALL abort
240	ENDIF
241	#ifdef NC_DOUBLE
242	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
243	#else
244	ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
245	#endif
246	IF (ierr .NE. NF_NOERR) THEN
247	PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
248	CALL abort
249	ENDIF
250
251	ierr = NF_INQ_VARID (nid, "Time", nvarid)
252	IF (ierr .NE. NF_NOERR) THEN
253	ierr = NF_INQ_VARID (nid, "temps", nvarid)
254	IF (ierr .NE. NF_NOERR) THEN
255	PRINT*, "dynetat0: <Time> or <temps> absent"
256	CALL abort
257	ENDIF
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 <Time>/<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	IF(nq.GE.1) THEN
316	write(,) 'dynetat0: loading tracers'
317	IF(nq.GT.99) THEN
318	PRINT*, "Trop de traceurs"
319	CALL abort
320	ENDIF
321	nqold=nq
322	DO iq=1,nq
323	! str3(1:1)='q'
324	! WRITE(str3(2:3),'(i2.2)') iq
325	! ierr = NF_INQ_VARID (nid, str3, nvarid)
326	! NB: tracers are now read in using their name ('tnom' from advtrac.h)
327	! write(,) " loading tracer:",trim(tnom(iq))
328	ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
329	IF (ierr .NE. NF_NOERR) THEN
330	! PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
331	PRINT*, "dynetat0: Le champ <"//trim(tnom(iq))//
332	& "> est absent"
333	PRINT*, " Il est donc initialise a zero"
334	CALL initial0(ijp1llm,q(1,1,1,iq))
335	nqold=min(iq-1,nqold)
336	ELSE
337	#ifdef NC_DOUBLE
338	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
339	#else
340	ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
341	#endif
342	IF (ierr .NE. NF_NOERR) THEN
343	! PRINT*, "dynetat0: Lecture echouee pour "//str3
344	PRINT*, "dynetat0: Lecture echouee pour "//trim(tnom(iq))
345	CALL abort
346	ENDIF
347	ENDIF
348	ENDDO
349	if ((nqold.lt.nq).and.(nqold.ge.1)) then
350	c case when new tracer are added in addition to old ones
351	write(,)'tracers 1 to ', nqold,'were already present'
352	write(,)'tracers ', nqold+1,' to ', nqmx,'are new'
353	write(,)' and initialized to zero'
354	q(:,:,:,nqold+1:nqmx)=0.0
355	! yes=' '
356	! do while ((yes.ne.'y').and.(yes.ne.'n'))
357	! write(,) 'Would you like to reindex tracer # 1 ->',nqold
358	! write(,) 'to #',nqmx-nqold+1,'->', nqmx,' (y or n) ?'
359	! read(*,fmt='(a)') yes
360	! end do
361	! if (yes.eq.'y') then
362	! write(,) 'OK, let s reindex the tracers'
363	! do l=1,llm
364	! do j=1,jjp1
365	! do i=1,iip1
366	! do iq=nqmx,nqmx-nqold+1,-1
367	! q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)
368	! end do
369	! do iq=nqmx-nqold,1,-1
370	! q(i,j,l,iq)= 0.
371	! end do
372	! end do
373	! end do
374	! end do
375	! end if
376	end if ! of if ((nqold.lt.nq).and.(nqold.ge.1))
377	ENDIF ! of IF(nq.GE.1)
378
379	ierr = NF_INQ_VARID (nid, "masse", nvarid)
380	IF (ierr .NE. NF_NOERR) THEN
381	PRINT*, "dynetat0: Le champ <masse> est absent"
382	CALL abort
383	ENDIF
384	#ifdef NC_DOUBLE
385	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
386	#else
387	ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
388	#endif
389	IF (ierr .NE. NF_NOERR) THEN
390	PRINT*, "dynetat0: Lecture echouee pour <masse>"
391	CALL abort
392	ENDIF
393
394	ierr = NF_INQ_VARID (nid, "ps", nvarid)
395	IF (ierr .NE. NF_NOERR) THEN
396	PRINT*, "dynetat0: Le champ <ps> est absent"
397	CALL abort
398	ENDIF
399	#ifdef NC_DOUBLE
400	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
401	#else
402	ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
403	#endif
404	IF (ierr .NE. NF_NOERR) THEN
405	PRINT*, "dynetat0: Lecture echouee pour <ps>"
406	CALL abort
407	ENDIF
408
409	ierr = NF_CLOSE(nid)
410
411	day_ini=day_ini+INT(time)
412	time=time-INT(time)
413
414	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
415	*arrage est differente de la valeur parametree iim =',i4//)
416	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
417	*arrage est differente de la valeur parametree jjm =',i4//)
418	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
419	*rrage est differente de la valeur parametree llm =',i4//)
420	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
421	*rrage est differente de la valeur dtinteg =',i4//)
422
423	RETURN
424	END

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

Download in other formats:

Original Format