source: LMDZ.3.3/trunk/libf/dyn3d/read_fstoke.F @ 2793

Last change on this file since 2793 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: 8.0 KB
Line 
1c $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       
52c ---------------------------------------------
53c   Initialisation de la lecture des fichiers
54c ---------------------------------------------
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
102c 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
109c 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
126c 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
134c 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
172c 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
184c 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
191c 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
202c ---------------------
203c   lecture des champs
204c ---------------------
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
219c 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
225c      print*,'WARNING!!! Correction bidon pour palier a un '
226c      print*,'probleme dans la creation des fichiers nc'
227c      call correctbid(iim,jmo1*nlevnc,masse)
228        print*,'***********Lecture MASSE '
229       call dump2d(imo1,jmo1,masse,'MASSE COUCHE 1')
230c 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
236c      print*,'WARNING!!! Correction bidon pour palier a un '
237c      print*,'probleme dans la creation des fichiers nc'
238c      call correctbid(iim,jmo1*nlevnc,pbaru)
239c      call dump2d(imo1,jmo1,pbaru,'PBARUNC COUCHE 1')
240
241c 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
247c      print*,'WARNING!!! Correction bidon pour palier a un '
248c      print*,'probleme dans la creation des fichiers nc'
249c      call correctbid(iim,jmo1*nlevnc,w)
250c      call dump2d(imo1,jmo1,w,'WNC COUCHE 1')
251
252c 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
258c      print*,'WARNING!!! Correction bidon pour palier a un '
259c      print*,'probleme dans la creation des fichiers nc'
260c      call correctbid(iim,jmo1*nlevnc,teta)
261c      call dump2d(imo1,jmo1,teta,'TETANC COUCHE 1')
262
263c 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
269c      print*,'WARNING!!! Correction bidon pour palier a un '
270c      print*,'probleme dans la creation des fichiers nc'
271c      call correctbid(iim,jmo1*nlevnc,phi)
272c      call dump2d(imo1,jmo1,phi,'PHINC COUCHE 1')
273       
274        count(2) = zjm-1
275
276c  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
283c      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.