source: LMDZ.3.3/trunk/libf/dyn3d/read_pstoke.F @ 185

Last change on this file since 185 was 185, checked in by lmdzadmin, 24 years ago

Creation lecture des flux pour le offline en netcdf. Idelkadi
LF

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