Context Navigation

read_fstoke.F @ 418

Last change on this file since 418 was 232, checked in by lmdzadmin, 23 years ago
Merge par rapport a la branche principale LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 8.0 KB

Line
1	c $Header$
2	subroutine read_fstoke(irec,
3	. zrec,zim,zjm,zlm,rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,
4	. airedy,phis,
5	. masse,pbaru,pbarv,w,teta,phi)
6
7	IMPLICIT NONE
8
9	#include "netcdf.inc"
10	#include "dimensions.h"
11	#include "paramet.h"
12	#include "comgeom.h"
13	#include "comvert.h"
14
15	integer nlevnc,irec
16	parameter (nlevnc=19)
17	integer mode,l
18
19	integer imo,jmo,imo1,jmo1,imn,jmn
20	parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2)
21	parameter (imo1=imo+1,jmo1=jmo+1)
22
23	real*4 pbaru(imo1,jmo1,llm),pbarv(imo1,jmo,llm)
24	real*4 teta(imo1,jmo1,llm),phis(imo1,jmo1),phi(imo1,jmo1,llm)
25	real*4 masse(imo1,jmo1,llm),w(imo1,jmo1,llm)
26	real*4 airedy(imo1,jmo1)
27	real*4 rlonu_dy(imo1,jmo1),rlonv_dy(imo1,jmo),
28	. rlatu_dy(imo1,jmo1),rlatv_dy(imo1,jmo)
29	integer*4 ncrec,ncim,ncjm,nclm
30	integer*4 zrec,zim,zjm,zlm
31	integer*4 xid,yid,zid,tid
32	real*4 zdtvr,ziadvtrac
33	real adv(1), dtv(1)
34
35	integer ncidf,ncidfv
36	integer varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
37	integer varidpl,varidm
38	integer varidnlo,varidnla,varidnlov,varidnlav
39	save ncidf,ncidfv
40	save varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
41	save varidpl,varidm
42	save varidnlo,varidnla,varidnlov,varidnlav
43
44	real*4 pl(nlevnc)
45
46	integer start(4),count(4),status
47
48	real rcode
49
50	character namedim
51
52	c ---------------------------------------------
53	c Initialisation de la lecture des fichiers
54	c ---------------------------------------------
55
56	if (irec .eq. 0) then
57
58	ncidf=NCOPN('fluxstoke.nc',NCNOWRIT,rcode)
59
60	varidps=NCVID(ncidf,'phis',rcode)
61	print*,'ncidf,varidps',ncidf,varidps
62
63	varidpl=NCVID(ncidf,'sig_s',rcode)
64	print*,'ncidf,varidpl',ncidf,varidpl
65
66	varidnlo=NCVID(ncidf,'nav_lon',rcode)
67	print*,'ncidf,varidnlo',ncidf,varidnlo
68
69	varidnla=NCVID(ncidf,'nav_lat',rcode)
70	print*,'ncidf,varidnla',ncidf,varidnla
71
72	varidai=NCVID(ncidf,'aire',rcode)
73	print*,'ncidf,varidai',ncidf,varidai
74
75	varidm=NCVID(ncidf,'masse',rcode)
76	print*,'ncidf,varidm',ncidf,varidm
77
78	varidpu=NCVID(ncidf,'pbaru',rcode)
79	print*,'ncidf,varidpu',ncidf,varidpu
80
81	varidw=NCVID(ncidf,'w',rcode)
82	print*,'ncidf,varidw',ncidf,varidw
83
84	varidt=NCVID(ncidf,'teta',rcode)
85	print*,'ncidf,varidt',ncidf,varidt
86
87	varidph=NCVID(ncidf,'phi',rcode)
88	print*,'ncidf,varidph',ncidf,varidph
89
90	ncidfv=NCOPN('fluxstokev.nc',NCNOWRIT,rcode)
91
92	varidpv=NCVID(ncidfv,'pbarv',rcode)
93	print*,'ncidfv,varidpv',ncidfv,varidpv
94
95	varidnlov=NCVID(ncidfv,'nav_lon',rcode)
96	print*,'ncidf,varidnlov',ncidf,varidnlov
97
98	varidnlav=NCVID(ncidfv,'nav_lat',rcode)
99	print*,'ncidfv,varidnlav',ncidfv,varidnlav
100
101
102	c ID pour les dimensions
103
104	status = nf_inq_dimid(ncidf,'y',yid)
105	status = nf_inq_dimid(ncidf,'x',xid)
106	status = nf_inq_dimid(ncidf,'sig_s',zid)
107	status = nf_inq_dimid(ncidf,'time_counter',tid)
108
109	c lecture des dimensions
110
111	status = nf_inq_dim(ncidf,yid,namedim,ncjm)
112	status = nf_inq_dim(ncidf,xid,namedim,ncim)
113	status = nf_inq_dim(ncidf,zid,namedim,nclm)
114	status = nf_inq_dim(ncidf,tid,namedim,ncrec)
115
116	zjm=ncjm
117	zim=ncim
118	zlm=nclm
119	zrec=ncrec
120
121	write(,) 'read_fstoke : zrec = ', zrec
122	write(,) 'read_fstoke : zlm = ', zlm
123	write(,) 'read_fstoke : zim = ', zim
124	write(,) 'read_fstoke : zjm = ', zjm
125
126	c niveaux de pression
127
128	#ifdef NC_DOUBLE
129	status=NF_GET_VARA_DOUBLE(ncidf,varidpl,1,zlm,pl)
130	#else
131	status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl)
132	#endif
133
134	c rlonu,rlonv,rlatu,rlatv
135
136	start(1)=1
137	start(2)=1
138	start(3)=1
139	start(4)=0
140
141	count(1)=zim
142	count(2)=zjm
143	count(3)=1
144	count(4)=0
145
146	#ifdef NC_DOUBLE
147	status=NF_GET_VARA_DOUBLE(ncidf,varidnlo,start,count,rlonu_dy)
148	status=NF_GET_VARA_DOUBLE(ncidf,varidnla,start,count,rlatu_dy)
149	#else
150	status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy)
151	status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy)
152	#endif
153
154	start(1)=1
155	start(2)=1
156	start(3)=1
157	start(4)=0
158
159	count(1)=zim
160	count(2)=zjm-1
161	count(3)=1
162	count(4)=0
163
164	#ifdef NC_DOUBLE
165	status=NF_GET_VARA_DOUBLE(ncidfv,varidnlov,start,count,rlonv_dy)
166	status=NF_GET_VARA_DOUBLE(ncidfv,varidnlav,start,count,rlatv_dy)
167	#else
168	status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy)
169	status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy)
170	#endif
171
172	c Lecture de phis et aire
173
174	start(1)=1
175	start(2)=1
176	start(3)=1
177	start(4)=0
178
179	count(1)=zim
180	count(2)=zjm
181	count(3)=1
182	count(4)=0
183
184	c phis
185	#ifdef NC_DOUBLE
186	status=NF_GET_VARA_DOUBLE(ncidf,varidps,start,count,phis)
187	#else
188	status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis)
189	#endif
190
191	c aire
192	#ifdef NC_DOUBLE
193	status=NF_GET_VARA_DOUBLE(ncidf,varidai,start,count,airedy)
194	#else
195	status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy)
196	#endif
197
198	else
199
200	print*,'ok1'
201
202	c ---------------------
203	c lecture des champs
204	c ---------------------
205
206	print*,'WARNING!!! Il n y a pas de test de coherence'
207	print*,'sur le nombre de niveaux verticaux dans le fichier nc'
208
209	start(1)=1
210	start(2)=1
211	start(3)=1
212	start(4)=irec
213
214	count(1)=zim
215	count(2)=zjm
216	count(3)=zlm
217	count(4)=1
218
219	c masse
220	#ifdef NC_DOUBLE
221	status=NF_GET_VARA_DOUBLE(ncidf,varidm,start,count,masse)
222	#else
223	status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse)
224	#endif
225	c print*,'WARNING!!! Correction bidon pour palier a un '
226	c print*,'probleme dans la creation des fichiers nc'
227	c call correctbid(iim,jmo1*nlevnc,masse)
228	print,'**********Lecture MASSE '
229	call dump2d(imo1,jmo1,masse,'MASSE COUCHE 1')
230	c pbaru
231	#ifdef NC_DOUBLE
232	status=NF_GET_VARA_DOUBLE(ncidf,varidpu,start,count,pbaru)
233	#else
234	status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru)
235	#endif
236	c print*,'WARNING!!! Correction bidon pour palier a un '
237	c print*,'probleme dans la creation des fichiers nc'
238	c call correctbid(iim,jmo1*nlevnc,pbaru)
239	c call dump2d(imo1,jmo1,pbaru,'PBARUNC COUCHE 1')
240
241	c w
242	#ifdef NC_DOUBLE
243	status=NF_GET_VARA_DOUBLE(ncidf,varidw,start,count,w)
244	#else
245	status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w)
246	#endif
247	c print*,'WARNING!!! Correction bidon pour palier a un '
248	c print*,'probleme dans la creation des fichiers nc'
249	c call correctbid(iim,jmo1*nlevnc,w)
250	c call dump2d(imo1,jmo1,w,'WNC COUCHE 1')
251
252	c teta
253	#ifdef NC_DOUBLE
254	status=NF_GET_VARA_DOUBLE(ncidf,varidt,start,count,teta)
255	#else
256	status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta)
257	#endif
258	c print*,'WARNING!!! Correction bidon pour palier a un '
259	c print*,'probleme dans la creation des fichiers nc'
260	c call correctbid(iim,jmo1*nlevnc,teta)
261	c call dump2d(imo1,jmo1,teta,'TETANC COUCHE 1')
262
263	c phi
264	#ifdef NC_DOUBLE
265	status=NF_GET_VARA_DOUBLE(ncidf,varidph,start,count,phi)
266	#else
267	status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi)
268	#endif
269	c print*,'WARNING!!! Correction bidon pour palier a un '
270	c print*,'probleme dans la creation des fichiers nc'
271	c call correctbid(iim,jmo1*nlevnc,phi)
272	c call dump2d(imo1,jmo1,phi,'PHINC COUCHE 1')
273
274	count(2) = zjm-1
275
276	c pbarv
277	print*,'Lecture de pbarv irec=',irec
278	#ifdef NC_DOUBLE
279	status=NF_GET_VARA_DOUBLE(ncidfv,varidpv,start,count,pbarv)
280	#else
281	status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv)
282	#endif
283	c call correctbid(iim,jjm*nlevnc,pbarv)
284	PRINT,'****LECTURE DE PBARV****'
285	call dump2d(imo1,jjm,pbarv,'PBARVNC COUCHE 1')
286	print*,'Ok Lecture de pbarv irec=',irec
287	start(3)=irec
288	start(4)=0
289	count(2)=jmo1
290	count(3)=1
291	count(4)=0
292
293	endif
294	print*,'Fin read_fstoke a irec=',irec
295	return
296	end
297

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

Download in other formats:

Original Format