Context Navigation

dynetat0.F @ 536

Last change on this file since 536 was 253, checked in by emillour, 13 years ago

Generic GCM

Massive update to version 0.7

EM+RW

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

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

Download in other formats:

Original Format