Context Navigation

dynetat0.F @ 1115

Last change on this file since 1115 was 993, checked in by emillour, 12 years ago

Generic GCM:

Some more cleanup in dynamics:
- Moved "start2archive" (and auxilliary routines) to phystd
- removed unused (obsolete) testharm.F , para_netcdf.h , readhead_NC.F , angtot.h from dyn3d
- removed obsolete addit.F (and change corresponding lines in gcm)
- remove unused "description.h" (and many places where it was "included")

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

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

Download in other formats:

Original Format