source: LMDZ.3.3/trunk/libf/dyn3d/read_fstoke0.F @ 507

Last change on this file since 507 was 218, checked in by lmdz, 24 years ago

Generalisation des if NC_DOUBLE pour passer sur VPP MAF
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.6 KB
Line 
1c $Header$
2        subroutine read_fstoke0(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      real*4 pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
20      real*4 teta(iip1,jjp1,llm),phis(iip1,jjp1),phi(iip1,jjp1,llm)
21      real*4 masse(iip1,jjp1,llm),w(iip1,jjp1,llm)
22      real*4 airedy(iip1,jjp1)
23      real*4 rlonu_dy(iip1,jjp1),rlonv_dy(iip1,jjm),
24     . rlatu_dy(iip1,jjp1),rlatv_dy(iip1,jjm)
25      integer*4 ncrec,ncim,ncjm,nclm
26      integer*4 zrec,zim,zjm,zlm
27      integer*4 xid,yid,zid,tid
28      real*4 zdtvr,ziadvtrac
29      real adv(1), dtv(1)
30
31      integer ncidf,ncidfv
32      integer varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
33      integer varidpl,varidm
34      integer varidnlo,varidnla,varidnlov,varidnlav
35      save ncidf,ncidfv
36      save varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
37      save varidpl,varidm
38      save varidnlo,varidnla,varidnlov,varidnlav
39
40      real*4 pl(nlevnc)
41
42      integer start(4),count(4),status
43
44      real rcode
45       
46      character namedim
47       
48c ---------------------------------------------
49c   Initialisation de la lecture des fichiers
50c ---------------------------------------------
51
52      if (irec .eq. 0) then
53
54            ncidf=NCOPN('fluxstoke.nc',NCNOWRIT,rcode)
55
56            varidps=NCVID(ncidf,'phis',rcode)
57            print*,'ncidf,varidps',ncidf,varidps
58
59            varidpl=NCVID(ncidf,'sig_s',rcode)
60            print*,'ncidf,varidpl',ncidf,varidpl
61       
62            varidnlo=NCVID(ncidf,'nav_lon',rcode)
63            print*,'ncidf,varidnlo',ncidf,varidnlo
64         
65            varidnla=NCVID(ncidf,'nav_lat',rcode)
66            print*,'ncidf,varidnla',ncidf,varidnla
67       
68            varidai=NCVID(ncidf,'aire',rcode)
69            print*,'ncidf,varidai',ncidf,varidai
70         
71            varidm=NCVID(ncidf,'masse',rcode)
72            print*,'ncidf,varidm',ncidf,varidm
73
74            varidpu=NCVID(ncidf,'pbaru',rcode)
75            print*,'ncidf,varidpu',ncidf,varidpu
76               
77            varidw=NCVID(ncidf,'w',rcode)
78            print*,'ncidf,varidw',ncidf,varidw
79       
80            varidt=NCVID(ncidf,'teta',rcode)
81            print*,'ncidf,varidt',ncidf,varidt
82 
83            varidph=NCVID(ncidf,'phi',rcode)
84            print*,'ncidf,varidph',ncidf,varidph
85       
86            ncidfv=NCOPN('fluxstokev.nc',NCNOWRIT,rcode)
87
88            varidpv=NCVID(ncidfv,'pbarv',rcode)
89            print*,'ncidfv,varidpv',ncidfv,varidpv
90       
91            varidnlov=NCVID(ncidfv,'nav_lon',rcode)
92            print*,'ncidf,varidnlov',ncidf,varidnlov
93         
94            varidnlav=NCVID(ncidfv,'nav_lat',rcode)
95            print*,'ncidfv,varidnlav',ncidfv,varidnlav
96       
97
98c ID pour les dimensions
99       
100            status = nf_inq_dimid(ncidf,'y',yid)
101            status = nf_inq_dimid(ncidf,'x',xid)
102            status = nf_inq_dimid(ncidf,'sig_s',zid)
103            status = nf_inq_dimid(ncidf,'time_counter',tid)
104
105c lecture des dimensions
106       
107            status = nf_inq_dim(ncidf,yid,namedim,ncjm)
108            status = nf_inq_dim(ncidf,xid,namedim,ncim)
109            status = nf_inq_dim(ncidf,zid,namedim,nclm)
110            status = nf_inq_dim(ncidf,tid,namedim,ncrec)
111       
112            zjm=ncjm
113            zim=ncim
114            zlm=nclm
115            zrec=ncrec
116       
117            write(*,*) 'read_fstoke : zrec = ', zrec
118            write(*,*) 'read_fstoke : zlm = ', zlm
119            write(*,*) 'read_fstoke : zim = ', zim
120            write(*,*) 'read_fstoke : zjm = ', zjm
121
122c niveaux de pression
123       
124#ifdef NC_DOUBLE
125       status=NF_GET_VARA_DOUBLE(ncidf,varidpl,1,zlm,pl)
126#else
127       status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl)
128#endif
129
130c 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#ifdef NC_DOUBLE
143      status=NF_GET_VARA_DOUBLE(ncidf,varidnlo,start,count,rlonu_dy)
144      status=NF_GET_VARA_DOUBLE(ncidf,varidnla,start,count,rlatu_dy)
145#else
146      status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy)
147      status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy)
148#endif
149
150      start(1)=1
151      start(2)=1
152      start(3)=1
153      start(4)=0
154
155      count(1)=zim
156      count(2)=zjm-1
157      count(3)=1
158      count(4)=0
159
160#ifdef NC_DOUBLE
161      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlov,start,count,rlonv_dy)
162      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlav,start,count,rlatv_dy)
163#else
164      status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy)
165      status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy)
166#endif
167
168c Lecture de phis et aire
169       
170      start(1)=1
171      start(2)=1
172      start(3)=1
173      start(4)=0
174
175      count(1)=zim
176      count(2)=zjm
177      count(3)=1
178      count(4)=0
179
180c phis
181#ifdef NC_DOUBLE
182      status=NF_GET_VARA_DOUBLE(ncidf,varidps,start,count,phis)
183#else
184      status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis)
185#endif
186
187c aire
188#ifdef NC_DOUBLE
189       status=NF_GET_VARA_DOUBLE(ncidf,varidai,start,count,airedy)
190#else
191       status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy)
192#endif
193
194       else
195
196      print*,'ok1'
197
198c ---------------------
199c   lecture des champs
200c ---------------------
201
202      print*,'WARNING!!! Il n y a pas de test de coherence'
203      print*,'sur le nombre de niveaux verticaux dans le fichier nc'
204
205      start(1)=1
206      start(2)=1
207      start(3)=1
208      start(4)=irec
209
210      count(1)=zim
211      count(2)=zjm
212      count(3)=zlm
213      count(4)=1
214
215c masse
216        PRINT*,'LECTURE DE masse'
217#ifdef NC_DOUBLE
218      status=NF_GET_VARA_DOUBLE(ncidf,varidm,start,count,masse)
219#else
220      status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse)
221#endif
222
223c pbaru
224#ifdef NC_DOUBLE
225      status=NF_GET_VARA_DOUBLE(ncidf,varidpu,start,count,pbaru)
226#else
227      status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru)
228#endif
229
230c w
231#ifdef NC_DOUBLE
232      status=NF_GET_VARA_DOUBLE(ncidf,varidw,start,count,w)
233#else
234      status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w)
235#endif
236
237c teta
238#ifdef NC_DOUBLE
239      status=NF_GET_VARA_DOUBLE(ncidf,varidt,start,count,teta)
240#else
241      status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta)
242#endif
243
244c phi
245#ifdef NC_DOUBLE
246      status=NF_GET_VARA_DOUBLE(ncidf,varidph,start,count,phi)
247#else
248      status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi)
249#endif
250       
251        count(2) = zjm-1
252
253c  pbarv
254#ifdef NC_DOUBLE
255      status=NF_GET_VARA_DOUBLE(ncidfv,varidpv,start,count,pbarv)
256#else
257      status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv)
258#endif
259
260      start(3)=irec
261      start(4)=0
262      count(2)=jjp1
263      count(3)=1
264      count(4)=0
265
266        endif
267
268      return
269      end
Note: See TracBrowser for help on using the repository browser.