Context Navigation

dynetat0.F @ 1422

Last change on this file since 1422 was 1422, checked in by milmd, 10 years ago
In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).
File size: 12.7 KB

Line
1	SUBROUTINE dynetat0(fichnom,vcov,ucov,
2	. teta,q,masse,ps,phis,time)
3	use infotrac, only: tname, nqtot
4	USE comvert_mod, ONLY: pa,preff
5	USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr,rad,omeg,g,cpp,
6	. kappa
7	USE logic_mod, ONLY: fxyhypb,ysinus
8	USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy,
9	. taux,tauy
10	USE temps_mod, ONLY: day_ini
11	USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
12	IMPLICIT NONE
13
14	c=======================================================================
15	c
16	c Auteur: P. Le Van / L.Fairhead
17	c -------
18	c
19	c objet:
20	c ------
21	c
22	c Lecture de l'etat initial
23	c
24	c Modifs: Oct.2008 read in tracers by name. Ehouarn Millour
25	c
26	c=======================================================================
27	c-----------------------------------------------------------------------
28	c Declarations:
29	c -------------
30
31	#include "dimensions.h"
32	#include "paramet.h"
33	#include "comgeom.h"
34	#include "netcdf.inc"
35	!#include"advtrac.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(iip1,jjp1,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,i,j,l
50	PARAMETER (length = 100)
51	REAL tab_cntrl(length) ! tableau des parametres du run
52	INTEGER ierr, nid, nvarid, nqold
53	CHARACTER str33,yes1
54
55
56	! added by RW for test
57	real pmean,airetot
58	integer ij
59
60	c-----------------------------------------------------------------------
61
62	c Ouverture NetCDF du fichier etat initial
63
64	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
65	IF (ierr.NE.NF_NOERR) THEN
66	write(6,*)' Pb d''ouverture du fichier ',fichnom
67	CALL ABORT
68	ENDIF
69
70	c
71	ierr = NF_INQ_VARID (nid, "controle", nvarid)
72	IF (ierr .NE. NF_NOERR) THEN
73	PRINT*, "dynetat0: Le champ <controle> est absent"
74	CALL abort
75	ENDIF
76	#ifdef NC_DOUBLE
77	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
78	#else
79	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
80	#endif
81	IF (ierr .NE. NF_NOERR) THEN
82	PRINT*, "dynetat0: Lecture echoue pour <controle>"
83	CALL abort
84	ENDIF
85
86	im = tab_cntrl(1)
87	jm = tab_cntrl(2)
88	lllm = tab_cntrl(3)
89	day_ini = tab_cntrl(4)
90	rad = tab_cntrl(5)
91	omeg = tab_cntrl(6)
92	g = tab_cntrl(7)
93	cpp = tab_cntrl(8)
94	kappa = tab_cntrl(9)
95	daysec = tab_cntrl(10)
96	dtvr = tab_cntrl(11)
97	etot0 = tab_cntrl(12)
98	ptot0 = tab_cntrl(13)
99	ztot0 = tab_cntrl(14)
100	stot0 = tab_cntrl(15)
101	ang0 = tab_cntrl(16)
102	pa = tab_cntrl(17)
103	preff = tab_cntrl(18)
104	c
105	clon = tab_cntrl(19)
106	clat = tab_cntrl(20)
107	grossismx = tab_cntrl(21)
108	grossismy = tab_cntrl(22)
109	c
110	IF ( tab_cntrl(23).EQ.1. ) THEN
111	fxyhypb = . TRUE .
112	dzoomx = tab_cntrl(24)
113	dzoomy = tab_cntrl(25)
114	taux = tab_cntrl(27)
115	tauy = tab_cntrl(28)
116	ELSE
117	fxyhypb = . FALSE .
118	ysinus = . FALSE .
119	IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE.
120	ENDIF
121	c .................................................................
122	c
123	c
124	PRINT*,'dynetat0: rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
125
126	IF( im.ne.iim ) THEN
127	PRINT 1,im,iim
128	STOP
129	ELSE IF( jm.ne.jjm ) THEN
130	PRINT 2,jm,jjm
131	STOP
132	ELSE IF( lllm.ne.llm ) THEN
133	PRINT 3,lllm,llm
134	STOP
135	ENDIF
136
137	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
138	IF (ierr .NE. NF_NOERR) THEN
139	PRINT*, "dynetat0: Le champ <rlonu> est absent"
140	CALL abort
141	ENDIF
142	#ifdef NC_DOUBLE
143	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
144	#else
145	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
146	#endif
147	IF (ierr .NE. NF_NOERR) THEN
148	PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
149	CALL abort
150	ENDIF
151
152	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
153	IF (ierr .NE. NF_NOERR) THEN
154	PRINT*, "dynetat0: Le champ <rlatu> est absent"
155	CALL abort
156	ENDIF
157	#ifdef NC_DOUBLE
158	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
159	#else
160	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
161	#endif
162	IF (ierr .NE. NF_NOERR) THEN
163	PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
164	CALL abort
165	ENDIF
166
167	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
168	IF (ierr .NE. NF_NOERR) THEN
169	PRINT*, "dynetat0: Le champ <rlonv> est absent"
170	CALL abort
171	ENDIF
172	#ifdef NC_DOUBLE
173	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
174	#else
175	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
176	#endif
177	IF (ierr .NE. NF_NOERR) THEN
178	PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
179	CALL abort
180	ENDIF
181
182	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
183	IF (ierr .NE. NF_NOERR) THEN
184	PRINT*, "dynetat0: Le champ <rlatv> est absent"
185	CALL abort
186	ENDIF
187	#ifdef NC_DOUBLE
188	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
189	#else
190	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
191	#endif
192	IF (ierr .NE. NF_NOERR) THEN
193	PRINT*, "dynetat0: Lecture echouee pour rlatv"
194	CALL abort
195	ENDIF
196
197	ierr = NF_INQ_VARID (nid, "cu", nvarid)
198	IF (ierr .NE. NF_NOERR) THEN
199	PRINT*, "dynetat0: Le champ <cu> est absent"
200	CALL abort
201	ENDIF
202	#ifdef NC_DOUBLE
203	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
204	#else
205	ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
206	#endif
207	IF (ierr .NE. NF_NOERR) THEN
208	PRINT*, "dynetat0: Lecture echouee pour <cu>"
209	CALL abort
210	ENDIF
211
212	ierr = NF_INQ_VARID (nid, "cv", nvarid)
213	IF (ierr .NE. NF_NOERR) THEN
214	PRINT*, "dynetat0: Le champ <cv> est absent"
215	CALL abort
216	ENDIF
217	#ifdef NC_DOUBLE
218	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
219	#else
220	ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
221	#endif
222	IF (ierr .NE. NF_NOERR) THEN
223	PRINT*, "dynetat0: Lecture echouee pour <cv>"
224	CALL abort
225	ENDIF
226
227	ierr = NF_INQ_VARID (nid, "aire", nvarid)
228	IF (ierr .NE. NF_NOERR) THEN
229	PRINT*, "dynetat0: Le champ <aire> est absent"
230	CALL abort
231	ENDIF
232	#ifdef NC_DOUBLE
233	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
234	#else
235	ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
236	#endif
237	IF (ierr .NE. NF_NOERR) THEN
238	PRINT*, "dynetat0: Lecture echouee pour <aire>"
239	CALL abort
240	ENDIF
241
242	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
243	IF (ierr .NE. NF_NOERR) THEN
244	PRINT*, "dynetat0: Le champ <phisinit> est absent"
245	CALL abort
246	ENDIF
247	#ifdef NC_DOUBLE
248	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
249	#else
250	ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
251	#endif
252	IF (ierr .NE. NF_NOERR) THEN
253	PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
254	CALL abort
255	ENDIF
256
257	ierr = NF_INQ_VARID (nid, "Time", nvarid)
258	IF (ierr .NE. NF_NOERR) THEN
259	ierr = NF_INQ_VARID (nid, "temps", nvarid)
260	IF (ierr .NE. NF_NOERR) THEN
261	PRINT*, "dynetat0: <Time> or <temps> absent"
262	CALL abort
263	ENDIF
264	ENDIF
265	#ifdef NC_DOUBLE
266	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
267	#else
268	ierr = NF_GET_VAR_REAL(nid, nvarid, time)
269	#endif
270	IF (ierr .NE. NF_NOERR) THEN
271	PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
272	CALL abort
273	ENDIF
274
275	ierr = NF_INQ_VARID (nid, "ucov", nvarid)
276	IF (ierr .NE. NF_NOERR) THEN
277	PRINT*, "dynetat0: Le champ <ucov> est absent"
278	CALL abort
279	ENDIF
280	#ifdef NC_DOUBLE
281	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
282	#else
283	ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
284	#endif
285	IF (ierr .NE. NF_NOERR) THEN
286	PRINT*, "dynetat0: Lecture echouee pour <ucov>"
287	CALL abort
288	ENDIF
289
290	ierr = NF_INQ_VARID (nid, "vcov", nvarid)
291	IF (ierr .NE. NF_NOERR) THEN
292	PRINT*, "dynetat0: Le champ <vcov> est absent"
293	CALL abort
294	ENDIF
295	#ifdef NC_DOUBLE
296	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
297	#else
298	ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
299	#endif
300	IF (ierr .NE. NF_NOERR) THEN
301	PRINT*, "dynetat0: Lecture echouee pour <vcov>"
302	CALL abort
303	ENDIF
304
305	ierr = NF_INQ_VARID (nid, "teta", nvarid)
306	IF (ierr .NE. NF_NOERR) THEN
307	PRINT*, "dynetat0: Le champ <teta> est absent"
308	CALL abort
309	ENDIF
310	#ifdef NC_DOUBLE
311	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
312	#else
313	ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
314	#endif
315	IF (ierr .NE. NF_NOERR) THEN
316	PRINT*, "dynetat0: Lecture echouee pour <teta>"
317	CALL abort
318	ENDIF
319
320
321	IF(nqtot.GE.1) THEN
322	write(,) 'dynetat0: loading tracers'
323	IF(nqtot.GT.99) THEN
324	PRINT*, "Trop de traceurs"
325	CALL abort
326	ENDIF
327	nqold=nqtot
328	DO iq=1,nqtot
329	! str3(1:1)='q'
330	! WRITE(str3(2:3),'(i2.2)') iq
331	! ierr = NF_INQ_VARID (nid, str3, nvarid)
332	! NB: tracers are now read in using their name ('tname' from infotrac)
333	! write(,) " loading tracer:",trim(tname(iq))
334	ierr=NF_INQ_VARID(nid,tname(iq),nvarid)
335	IF (ierr .NE. NF_NOERR) THEN
336	! PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
337	PRINT*, "dynetat0: Le champ <"//trim(tname(iq))//
338	& "> est absent"
339	PRINT*, " Il est donc initialise a zero"
340	CALL initial0(ijp1llm,q(1,1,1,iq))
341	nqold=min(iq-1,nqold)
342	ELSE
343	#ifdef NC_DOUBLE
344	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
345	#else
346	ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
347	#endif
348	IF (ierr .NE. NF_NOERR) THEN
349	! PRINT*, "dynetat0: Lecture echouee pour "//str3
350	PRINT*,"dynetat0: Lecture echouee pour "//trim(tname(iq))
351	CALL abort
352	ENDIF
353	ENDIF
354	ENDDO
355	if ((nqold.lt.nqtot).and.(nqold.ge.1)) then
356	c case when new tracer are added in addition to old ones
357	write(,)'tracers 1 to ', nqold,'were already present'
358	write(,)'tracers ', nqold+1,' to ', nqtot,'are new'
359	write(,)' and initialized to zero'
360	q(:,:,:,nqold+1:nqtot)=0.0
361	! yes=' '
362	! do while ((yes.ne.'y').and.(yes.ne.'n'))
363	! write(,) 'Would you like to reindex tracer # 1 ->',nqold
364	! write(,) 'to #',nqmx-nqold+1,'->', nqmx,' (y or n) ?'
365	! read(*,fmt='(a)') yes
366	! end do
367	! if (yes.eq.'y') then
368	! write(,) 'OK, let s reindex the tracers'
369	! do l=1,llm
370	! do j=1,jjp1
371	! do i=1,iip1
372	! do iq=nqmx,nqmx-nqold+1,-1
373	! q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)
374	! end do
375	! do iq=nqmx-nqold,1,-1
376	! q(i,j,l,iq)= 0.
377	! end do
378	! end do
379	! end do
380	! end do
381	! end if
382	end if ! of if ((nqold.lt.nqtot).and.(nqold.ge.1))
383	ENDIF ! of IF(nqtot.GE.1)
384
385	ierr = NF_INQ_VARID (nid, "masse", nvarid)
386	IF (ierr .NE. NF_NOERR) THEN
387	PRINT*, "dynetat0: Le champ <masse> est absent"
388	CALL abort
389	ENDIF
390	#ifdef NC_DOUBLE
391	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
392	#else
393	ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
394	#endif
395	IF (ierr .NE. NF_NOERR) THEN
396	PRINT*, "dynetat0: Lecture echouee pour <masse>"
397	CALL abort
398	ENDIF
399
400	ierr = NF_INQ_VARID (nid, "ps", nvarid)
401	IF (ierr .NE. NF_NOERR) THEN
402	PRINT*, "dynetat0: Le champ <ps> est absent"
403	CALL abort
404	ENDIF
405	#ifdef NC_DOUBLE
406	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
407	#else
408	ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
409	#endif
410	IF (ierr .NE. NF_NOERR) THEN
411	PRINT*, "dynetat0: Lecture echouee pour <ps>"
412	CALL abort
413	ENDIF
414
415	ierr = NF_CLOSE(nid)
416
417	day_ini=day_ini+INT(time)
418	time=time-INT(time)
419
420	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
421	*arrage est differente de la valeur parametree iim =',i4//)
422	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
423	*arrage est differente de la valeur parametree jjm =',i4//)
424	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
425	*rrage est differente de la valeur parametree llm =',i4//)
426	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
427	*rrage est differente de la valeur dtinteg =',i4//)
428
429
430
431
432
433
434	RETURN
435	END

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

Download in other formats:

Original Format