Context Navigation

read_fstoke.F @ 198

Last change on this file since 198 was 198, checked in by lmdz, 23 years ago
Mise a niveau du offline FH LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 7.2 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	real 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	status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl)
129
130	c rlonu,rlonv,rlatu,rlatv
131
132	start(1)=1
133	start(2)=1
134	start(3)=1
135	start(4)=0
136
137	count(1)=zim
138	count(2)=zjm
139	count(3)=1
140	count(4)=0
141
142	status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy)
143	status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy)
144
145	start(1)=1
146	start(2)=1
147	start(3)=1
148	start(4)=0
149
150	count(1)=zim
151	count(2)=zjm-1
152	count(3)=1
153	count(4)=0
154
155	status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy)
156	status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy)
157
158	c Lecture de phis et aire
159
160	start(1)=1
161	start(2)=1
162	start(3)=1
163	start(4)=0
164
165	count(1)=zim
166	count(2)=zjm
167	count(3)=1
168	count(4)=0
169
170	c phis
171	status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis)
172	c print*,'WARNING!!! Correction bidon pour palier a un '
173	c print*,'probleme dans la creation des fichiers nc'
174	c call correctbid(iim,jmo1*1,phis)
175	call dump2d(imo1,jmo1,phis,'PHISNC')
176
177	c aire
178	status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy)
179	c call correctbid(iim,jmo1*1,airedy)
180	c call dump2d(imo1,jmo1,airedy,'AIRENC')
181
182	c status= NF_CLOSE(ncidf)
183
184	else
185
186	print*,'ok1'
187	c stop'TEST lectfluxnc'
188
189	c ---------------------
190	c lecture des champs
191	c ---------------------
192
193	print*,'WARNING!!! Il n y a pas de test de coherence'
194	print*,'sur le nombre de niveaux verticaux dans le fichier nc'
195
196	start(1)=1
197	start(2)=1
198	start(3)=1
199	start(4)=irec
200
201	count(1)=zim
202	count(2)=zjm
203	count(3)=zlm
204	count(4)=1
205
206	c masse
207	status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse)
208	c print*,'WARNING!!! Correction bidon pour palier a un '
209	c print*,'probleme dans la creation des fichiers nc'
210	c call correctbid(iim,jmo1*nlevnc,masse)
211	print,'**********Lecture MASSE '
212	call dump2d(imo1,jmo1,masse,'MASSE COUCHE 1')
213	c pbaru
214	status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru)
215	c print*,'WARNING!!! Correction bidon pour palier a un '
216	c print*,'probleme dans la creation des fichiers nc'
217	c call correctbid(iim,jmo1*nlevnc,pbaru)
218	c call dump2d(imo1,jmo1,pbaru,'PBARUNC COUCHE 1')
219
220	c w
221	status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w)
222	c print*,'WARNING!!! Correction bidon pour palier a un '
223	c print*,'probleme dans la creation des fichiers nc'
224	c call correctbid(iim,jmo1*nlevnc,w)
225	c call dump2d(imo1,jmo1,w,'WNC COUCHE 1')
226
227	c teta
228	status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta)
229	c print*,'WARNING!!! Correction bidon pour palier a un '
230	c print*,'probleme dans la creation des fichiers nc'
231	c call correctbid(iim,jmo1*nlevnc,teta)
232	c call dump2d(imo1,jmo1,teta,'TETANC COUCHE 1')
233
234	c phi
235	status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi)
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,phi)
239	c call dump2d(imo1,jmo1,phi,'PHINC COUCHE 1')
240
241	count(2) = zjm-1
242
243	c pbarv
244	print*,'Lecture de pbarv irec=',irec
245	status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv)
246	c call correctbid(iim,jjm*nlevnc,pbarv)
247	PRINT,'****LECTURE DE PBARV****'
248	call dump2d(imo1,jjm,pbarv,'PBARVNC COUCHE 1')
249	print*,'Ok Lecture de pbarv irec=',irec
250	start(3)=irec
251	start(4)=0
252	count(2)=jmo1
253	count(3)=1
254	count(4)=0
255
256	endif
257	print*,'Fin read_fstoke a irec=',irec
258	return
259	end
260

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

Download in other formats:

Original Format