source: LMDZ.3.3/branches/rel-LF/libf/phylmd/read_pstoke.F @ 222

Last change on this file since 222 was 222, checked in by (none), 23 years ago

This commit was manufactured by cvs2svn to create branch 'rel-LF'.

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