Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

dynetat0.F @ 3436

Last change on this file since 3436 was 3175, checked in by emillour, 11 months ago
Pluto PCM: Add the old Pluto LMDZ for reference (required prior step to making an LMDZ.PLUTO using the same framework as the other physics packages). TB+EM
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: in start.nc:'
119	PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
120
121	IF( im.ne.iim ) THEN
122	PRINT 1,im,iim
123	STOP
124	ELSE IF( jm.ne.jjm ) THEN
125	PRINT 2,jm,jjm
126	STOP
127	ELSE IF( lllm.ne.llm ) THEN
128	PRINT 3,lllm,llm
129	STOP
130	ENDIF
131
132	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
133	IF (ierr .NE. NF_NOERR) THEN
134	PRINT*, "dynetat0: Le champ <rlonu> est absent"
135	CALL abort
136	ENDIF
137	#ifdef NC_DOUBLE
138	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
139	#else
140	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
141	#endif
142	IF (ierr .NE. NF_NOERR) THEN
143	PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
144	CALL abort
145	ENDIF
146
147	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
148	IF (ierr .NE. NF_NOERR) THEN
149	PRINT*, "dynetat0: Le champ <rlatu> est absent"
150	CALL abort
151	ENDIF
152	#ifdef NC_DOUBLE
153	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
154	#else
155	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
156	#endif
157	IF (ierr .NE. NF_NOERR) THEN
158	PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
159	CALL abort
160	ENDIF
161
162	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
163	IF (ierr .NE. NF_NOERR) THEN
164	PRINT*, "dynetat0: Le champ <rlonv> est absent"
165	CALL abort
166	ENDIF
167	#ifdef NC_DOUBLE
168	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
169	#else
170	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
171	#endif
172	IF (ierr .NE. NF_NOERR) THEN
173	PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
174	CALL abort
175	ENDIF
176
177	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
178	IF (ierr .NE. NF_NOERR) THEN
179	PRINT*, "dynetat0: Le champ <rlatv> est absent"
180	CALL abort
181	ENDIF
182	#ifdef NC_DOUBLE
183	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
184	#else
185	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
186	#endif
187	IF (ierr .NE. NF_NOERR) THEN
188	PRINT*, "dynetat0: Lecture echouee pour rlatv"
189	CALL abort
190	ENDIF
191
192	ierr = NF_INQ_VARID (nid, "cu", nvarid)
193	IF (ierr .NE. NF_NOERR) THEN
194	PRINT*, "dynetat0: Le champ <cu> est absent"
195	CALL abort
196	ENDIF
197	#ifdef NC_DOUBLE
198	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
199	#else
200	ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
201	#endif
202	IF (ierr .NE. NF_NOERR) THEN
203	PRINT*, "dynetat0: Lecture echouee pour <cu>"
204	CALL abort
205	ENDIF
206
207	ierr = NF_INQ_VARID (nid, "cv", nvarid)
208	IF (ierr .NE. NF_NOERR) THEN
209	PRINT*, "dynetat0: Le champ <cv> est absent"
210	CALL abort
211	ENDIF
212	#ifdef NC_DOUBLE
213	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
214	#else
215	ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
216	#endif
217	IF (ierr .NE. NF_NOERR) THEN
218	PRINT*, "dynetat0: Lecture echouee pour <cv>"
219	CALL abort
220	ENDIF
221
222	ierr = NF_INQ_VARID (nid, "aire", nvarid)
223	IF (ierr .NE. NF_NOERR) THEN
224	PRINT*, "dynetat0: Le champ <aire> est absent"
225	CALL abort
226	ENDIF
227	#ifdef NC_DOUBLE
228	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
229	#else
230	ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
231	#endif
232	IF (ierr .NE. NF_NOERR) THEN
233	PRINT*, "dynetat0: Lecture echouee pour <aire>"
234	CALL abort
235	ENDIF
236
237	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
238	IF (ierr .NE. NF_NOERR) THEN
239	PRINT*, "dynetat0: Le champ <phisinit> est absent"
240	CALL abort
241	ENDIF
242	#ifdef NC_DOUBLE
243	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
244	#else
245	ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
246	#endif
247	IF (ierr .NE. NF_NOERR) THEN
248	PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
249	CALL abort
250	ENDIF
251
252	ierr = NF_INQ_VARID (nid, "Time", nvarid)
253	IF (ierr .NE. NF_NOERR) THEN
254	ierr = NF_INQ_VARID (nid, "temps", nvarid)
255	IF (ierr .NE. NF_NOERR) THEN
256	PRINT*, "dynetat0: <Time> or <temps> absent"
257	CALL abort
258	ENDIF
259	ENDIF
260	#ifdef NC_DOUBLE
261	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
262	#else
263	ierr = NF_GET_VAR_REAL(nid, nvarid, time)
264	#endif
265	IF (ierr .NE. NF_NOERR) THEN
266	PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
267	CALL abort
268	ENDIF
269
270	ierr = NF_INQ_VARID (nid, "ucov", nvarid)
271	IF (ierr .NE. NF_NOERR) THEN
272	PRINT*, "dynetat0: Le champ <ucov> est absent"
273	CALL abort
274	ENDIF
275	#ifdef NC_DOUBLE
276	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
277	#else
278	ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
279	#endif
280	IF (ierr .NE. NF_NOERR) THEN
281	PRINT*, "dynetat0: Lecture echouee pour <ucov>"
282	CALL abort
283	ENDIF
284
285	ierr = NF_INQ_VARID (nid, "vcov", nvarid)
286	IF (ierr .NE. NF_NOERR) THEN
287	PRINT*, "dynetat0: Le champ <vcov> est absent"
288	CALL abort
289	ENDIF
290	#ifdef NC_DOUBLE
291	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
292	#else
293	ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
294	#endif
295	IF (ierr .NE. NF_NOERR) THEN
296	PRINT*, "dynetat0: Lecture echouee pour <vcov>"
297	CALL abort
298	ENDIF
299
300	ierr = NF_INQ_VARID (nid, "teta", nvarid)
301	IF (ierr .NE. NF_NOERR) THEN
302	PRINT*, "dynetat0: Le champ <teta> est absent"
303	CALL abort
304	ENDIF
305	#ifdef NC_DOUBLE
306	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
307	#else
308	ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
309	#endif
310	IF (ierr .NE. NF_NOERR) THEN
311	PRINT*, "dynetat0: Lecture echouee pour <teta>"
312	CALL abort
313	ENDIF
314
315
316	IF(nq.GE.1) THEN
317	write(,) 'dynetat0: loading tracers'
318	IF(nq.GT.99) THEN
319	PRINT*, "Trop de traceurs"
320	CALL abort
321	ENDIF
322	nqold=nq
323	DO iq=1,nq
324	! str3(1:1)='q'
325	! WRITE(str3(2:3),'(i2.2)') iq
326	! ierr = NF_INQ_VARID (nid, str3, nvarid)
327	! NB: tracers are now read in using their name ('tnom' from advtrac.h)
328	! write(,) " loading tracer:",trim(tnom(iq))
329	ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
330	IF (ierr .NE. NF_NOERR) THEN
331	! PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
332	PRINT*, "dynetat0: Le champ <"//trim(tnom(iq))//
333	& "> est absent"
334	PRINT*, " Il est donc initialise a zero"
335	CALL initial0(ijp1llm,q(1,1,1,iq))
336	nqold=min(iq-1,nqold)
337	ELSE
338	#ifdef NC_DOUBLE
339	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
340	#else
341	ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
342	#endif
343	IF (ierr .NE. NF_NOERR) THEN
344	! PRINT*, "dynetat0: Lecture echouee pour "//str3
345	PRINT*, "dynetat0: Lecture echouee pour "//trim(tnom(iq))
346	CALL abort
347	ENDIF
348	ENDIF
349	ENDDO
350	if ((nqold.lt.nq).and.(nqold.ge.1)) then
351	c case when new tracer are added in addition to old ones
352	write(,)'tracers 1 to ', nqold,'were already present'
353	write(,)'tracers ', nqold+1,' to ', nqmx,'are new'
354	write(,)' and initialized to zero'
355	q(:,:,:,nqold+1:nqmx)=0.0
356	! yes=' '
357	! do while ((yes.ne.'y').and.(yes.ne.'n'))
358	! write(,) 'Would you like to reindex tracer # 1 ->',nqold
359	! write(,) 'to #',nqmx-nqold+1,'->', nqmx,' (y or n) ?'
360	! read(*,fmt='(a)') yes
361	! end do
362	! if (yes.eq.'y') then
363	! write(,) 'OK, let s reindex the tracers'
364	! do l=1,llm
365	! do j=1,jjp1
366	! do i=1,iip1
367	! do iq=nqmx,nqmx-nqold+1,-1
368	! q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)
369	! end do
370	! do iq=nqmx-nqold,1,-1
371	! q(i,j,l,iq)= 0.
372	! end do
373	! end do
374	! end do
375	! end do
376	! end if
377	end if ! of if ((nqold.lt.nq).and.(nqold.ge.1))
378	ENDIF ! of IF(nq.GE.1)
379
380	ierr = NF_INQ_VARID (nid, "masse", nvarid)
381	IF (ierr .NE. NF_NOERR) THEN
382	PRINT*, "dynetat0: Le champ <masse> est absent"
383	CALL abort
384	ENDIF
385	#ifdef NC_DOUBLE
386	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
387	#else
388	ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
389	#endif
390	IF (ierr .NE. NF_NOERR) THEN
391	PRINT*, "dynetat0: Lecture echouee pour <masse>"
392	CALL abort
393	ENDIF
394
395	ierr = NF_INQ_VARID (nid, "ps", nvarid)
396	IF (ierr .NE. NF_NOERR) THEN
397	PRINT*, "dynetat0: Le champ <ps> est absent"
398	CALL abort
399	ENDIF
400	#ifdef NC_DOUBLE
401	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
402	#else
403	ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
404	#endif
405	IF (ierr .NE. NF_NOERR) THEN
406	PRINT*, "dynetat0: Lecture echouee pour <ps>"
407	CALL abort
408	ENDIF
409
410	ierr = NF_CLOSE(nid)
411	write(,) 'TB15 : dynetat0 : time = ',time
412	day_ini=day_ini+INT(time)
413	time=time-INT(time)
414
415	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
416	*arrage est differente de la valeur parametree iim =',i4//)
417	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
418	*arrage est differente de la valeur parametree jjm =',i4//)
419	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
420	*rrage est differente de la valeur parametree llm =',i4//)
421	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
422	*rrage est differente de la valeur dtinteg =',i4//)
423
424	RETURN
425	END

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

Download in other formats:

Original Format