Context Navigation

read_pstoke0.F @ 1905

Last change on this file since 1905 was 524, checked in by lmdzadmin, 20 years ago
Initial revision
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 10.2 KB

Line
1	!
2	! $Header$
3	!
4	c
5	c
6	subroutine read_pstoke0(irec,
7	. zrec,zkon,zkev,airefi,phisfi,
8	. t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
9	. frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
10
11
12	IMPLICIT NONE
13
14	#include "netcdf.inc"
15	#include "dimensions.h"
16	#include "paramet.h"
17	#include "comconst.h"
18	#include "comgeom.h"
19	#include "temps.h"
20	#include "ener.h"
21	#include "logic.h"
22	#include "description.h"
23	#include "serre.h"
24	#include "indicesol.h"
25	#include "control.h"
26	#include "dimphy.h"
27
28	integer*4 kon,kev,zkon,zkev
29	parameter(kon=iim*(jjm-1)+2,kev=llm)
30	REAL*4 phisfi(kon)
31	REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
32
33	REAL*4 mfu(kon,kev), mfd(kon,kev)
34	REAL*4 en_u(kon,kev), de_u(kon,kev)
35	REAL*4 en_d(kon,kev), de_d(kon,kev)
36	REAL*4 coefh(kon,kev)
37	REAL*4 t(kon,kev)
38
39	REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
40	REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
41	REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
42	REAL*4 coefh2(iim,jjm+1,kev)
43	REAL*4 t2(iim,jjm+1,kev)
44
45	REAL*4 pl(kev)
46	integer irec
47	integer*4 xid,yid,zid,tid
48	integer*4 zrec,zim,zjm
49	integer*4 ncrec,nckon,nckev,ncim,ncjm
50
51	real*4 airefi(kon)
52	character namedim
53
54	c !! attention !!
55	c attention il y a aussi le pb de def kon
56	c dim de phis??
57
58	REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev)
59	REAL*4 frac_impa2(iim,jjm+1,kev),
60	. frac_nucl2(iim,jjm+1,kev)
61	REAL*4 pyu1(kon), pyv1(kon)
62	REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1)
63	REAL*4 ftsol(kon,nbsrf)
64	REAL*4 psrf(kon,nbsrf)
65	REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
66	REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
67	REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
68	. ftsol32(iim,jjm+1),
69	. ftsol42(iim,jjm+1)
70	REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
71	. psrf42(iim,jjm+1)
72
73	integer ncidp
74	save ncidp
75	integer varidmfu, varidmfd, varidps, varidenu, variddeu
76	integer varidt
77	integer varidend,varidded,varidch,varidfi,varidfn
78	integer varidyu1,varidyv1,varidpl,varidai,varididvt
79	integer varidfts1,varidfts2,varidfts3,varidfts4
80	integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
81	save varidmfu, varidmfd, varidps, varidenu, variddeu
82	save varidt
83	save varidend,varidded,varidch,varidfi,varidfn
84	save varidyu1,varidyv1,varidpl,varidai,varididvt
85	save varidfts1,varidfts2,varidfts3,varidfts4
86	save varidpsr1,varidpsr2,varidpsr3,varidpsr4
87
88	integer l, i
89	integer start(4),count(4),status
90	real rcode
91	logical first
92	save first
93	data first/.true./
94
95
96
97	c ---------------------------------------------
98	c Initialisation de la lecture des fichiers
99	c ---------------------------------------------
100
101	if (irec .eq. 0) then
102
103	ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
104
105	varidps=NCVID(ncidp,'phis',rcode)
106	print*,'ncidp,varidps',ncidp,varidps
107
108	varidpl=NCVID(ncidp,'sig_s',rcode)
109	print*,'ncidp,varidpl',ncidp,varidpl
110
111	varidai=NCVID(ncidp,'aire',rcode)
112	print*,'ncidp,varidai',ncidp,varidai
113
114	varidmfu=NCVID(ncidp,'mfu',rcode)
115	print*,'ncidp,varidmfu',ncidp,varidmfu
116
117	varidt=NCVID(ncidp,'t',rcode)
118	print*,'ncidp,varidt',ncidp,varidt
119
120	varidmfd=NCVID(ncidp,'mfd',rcode)
121	print*,'ncidp,varidmfd',ncidp,varidmfd
122
123	varidenu=NCVID(ncidp,'en_u',rcode)
124	print*,'ncidp,varidenu',ncidp,varidenu
125
126	variddeu=NCVID(ncidp,'de_u',rcode)
127	print*,'ncidp,variddeu',ncidp,variddeu
128
129	varidend=NCVID(ncidp,'en_d',rcode)
130	print*,'ncidp,varidend',ncidp,varidend
131
132	varidded=NCVID(ncidp,'de_d',rcode)
133	print*,'ncidp,varidded',ncidp,varidded
134
135	varidch=NCVID(ncidp,'coefh',rcode)
136	print*,'ncidp,varidch',ncidp,varidch
137
138	varidfi=NCVID(ncidp,'frac_impa',rcode)
139	print*,'ncidp,varidfi',ncidp,varidfi
140
141	varidfn=NCVID(ncidp,'frac_nucl',rcode)
142	print*,'ncidp,varidfn',ncidp,varidfn
143
144	varidyu1=NCVID(ncidp,'pyu1',rcode)
145	print*,'ncidp,varidyu1',ncidp,varidyu1
146
147	varidyv1=NCVID(ncidp,'pyv1',rcode)
148	print*,'ncidp,varidyv1',ncidp,varidyv1
149
150	varidfts1=NCVID(ncidp,'ftsol1',rcode)
151	print*,'ncidp,varidfts1',ncidp,varidfts1
152
153	varidfts2=NCVID(ncidp,'ftsol2',rcode)
154	print*,'ncidp,varidfts2',ncidp,varidfts2
155
156	varidfts3=NCVID(ncidp,'ftsol3',rcode)
157	print*,'ncidp,varidfts3',ncidp,varidfts3
158
159	varidfts4=NCVID(ncidp,'ftsol4',rcode)
160	print*,'ncidp,varidfts4',ncidp,varidfts4
161
162	varidpsr1=NCVID(ncidp,'psrf1',rcode)
163	print*,'ncidp,varidpsr1',ncidp,varidpsr1
164
165	varidpsr2=NCVID(ncidp,'psrf2',rcode)
166	print*,'ncidp,varidpsr2',ncidp,varidpsr2
167
168	varidpsr3=NCVID(ncidp,'psrf3',rcode)
169	print*,'ncidp,varidpsr3',ncidp,varidpsr3
170
171	varidpsr4=NCVID(ncidp,'psrf4',rcode)
172	print*,'ncidp,varidpsr4',ncidp,varidpsr4
173
174	c ID pour les dimensions
175
176	status = nf_inq_dimid(ncidp,'y',yid)
177	status = nf_inq_dimid(ncidp,'x',xid)
178	status = nf_inq_dimid(ncidp,'sig_s',zid)
179	status = nf_inq_dimid(ncidp,'time_counter',tid)
180
181	c lecture des dimensions
182
183	status = nf_inq_dim(ncidp,yid,namedim,ncjm)
184	status = nf_inq_dim(ncidp,xid,namedim,ncim)
185	status = nf_inq_dim(ncidp,zid,namedim,nckev)
186	status = nf_inq_dim(ncidp,tid,namedim,ncrec)
187
188	zrec=ncrec
189	zkev=nckev
190	zim=ncim
191	zjm=ncjm
192
193	zkon=zim*(zjm-2)+2
194
195	write(,) 'read_pstoke : zrec = ', zrec
196	write(,) 'read_pstoke : kev = ', zkev
197	write(,) 'read_pstoke : zim = ', zim
198	write(,) 'read_pstoke : zjm = ', zjm
199	write(,) 'read_pstoke : kon = ', zkon
200
201	c niveaux de pression
202
203	status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl)
204
205	c lecture de aire et phis
206
207	start(1)=1
208	start(2)=1
209	start(3)=1
210	start(4)=0
211
212	count(1)=zim
213	count(2)=zjm
214	count(3)=1
215	count(4)=0
216
217	c
218	c phis
219	status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
220	call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
221
222	c aire
223	status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
224	call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
225	else
226
227	print*,'ok1'
228
229	c ---------------------
230	c lecture des champs
231	c ---------------------
232
233	print*,'WARNING!!! Il n y a pas de test de coherence'
234	print*,'sur le nombre de niveaux verticaux dans le fichier nc'
235
236	start(1)=1
237	start(2)=1
238	start(3)=1
239	start(4)=irec
240
241	count(1)=zim
242	count(2)=zjm
243	count(3)=kev
244	count(4)=1
245
246	c frac_impa
247
248	status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
249	call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
250
251	c frac_nucl
252
253	status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
254	call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
255
256	c abder t
257	status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
258	call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
259
260	c mfu
261	status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
262	call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
263
264	c mfd
265	status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
266	call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
267
268	c en_u
269	status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
270	call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
271
272	c de_u
273	status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
274	call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
275
276	c en_d
277	status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
278	call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
279
280	c de_d
281	status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
282	call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
283
284	c coefh
285	print*,'LECTURE de coefh a irec =',irec
286	status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
287	call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
288
289	start(3)=irec
290	start(4)=0
291	count(3)=1
292	count(4)=0
293
294	c pyu1
295	print*,'LECTURE de yu1 a irec =',irec
296	status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
297	call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
298
299	c pyv1
300	print*,'LECTURE de yv1 a irec =',irec
301	status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
302	call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
303
304	c ftsol1
305	print*,'LECTURE de ftsol1 a irec =',irec
306	status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
307	call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
308
309	c ftsol2
310	print*,'LECTURE de ftsol2 a irec =',irec
311	status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
312	call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
313
314	c ftsol3
315	print*,'LECTURE de ftsol3 a irec =',irec
316	status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
317	call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
318
319	c ftsol4
320	status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
321	call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
322
323	c psrf1
324	status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
325	c call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
326	call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
327
328	c psrf2
329	status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
330	c call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
331	call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
332
333	c psrf3
334	status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
335	call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
336
337	c psrf4
338	status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
339	call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
340
341	do i = 1,kon
342
343	psrf(i,1) = psrf1(i)
344	psrf(i,2) = psrf2(i)
345	psrf(i,3) = psrf3(i)
346	psrf(i,4) = psrf4(i)
347
348	ftsol(i,1) = ftsol1(i)
349	ftsol(i,2) = ftsol2(i)
350	ftsol(i,3) = ftsol3(i)
351	ftsol(i,4) = ftsol4(i)
352
353	enddo
354
355	endif
356
357	return
358
359	end
360

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

Download in other formats:

Original Format