Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

dynetat0.F @ 2276

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

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

Download in other formats:

Original Format