source: LMDZ4/trunk/libf/phylmd/read_pstoke.F @ 1280

Last change on this file since 1280 was 1146, checked in by Laurent Fairhead, 16 years ago

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.5 KB
Line 
1!
2! $Header$
3!
4c
5c
6        subroutine read_pstoke(irec,
7     .   zrec,zklono,zklevo,airefi,phisfi,
8     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
9     .   fm_therm,en_therm,
10     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
11
12C******************************************************************************
13C  Frederic HOURDIN, Abderrahmane IDELKADI
14C Lecture des parametres physique stockes online necessaires pour
15C recalculer offline le transport de traceurs sur une grille 2x plus fine que
16C celle online
17C A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
18C******************************************************************************
19
20        use netcdf
21       USE dimphy
22       IMPLICIT NONE
23
24#include "netcdf.inc"
25#include "dimensions.h"
26#include "paramet.h"
27#include "comconst.h"
28#include "comgeom.h"
29#include "temps.h"
30#include "ener.h"
31#include "logic.h"
32#include "description.h"
33#include "serre.h"
34#include "indicesol.h"
35#include "control.h"
36cccc#include "dimphy.h"
37       
38          integer klono,klevo,imo,jmo
39          parameter (imo=iim/2,jmo=(jjm+1)/2)
40          parameter(klono=(jmo-1)*imo+2,klevo=llm)
41          REAL phisfi(klono)
42          REAL phisfi2(imo,jmo+1),airefi2(imo,jmo+1)
43
44          REAL mfu(klono,klevo), mfd(klono,klevo)
45          REAL en_u(klono,klevo), de_u(klono,klevo)
46          REAL en_d(klono,klevo), de_d(klono,klevo)
47          REAL coefh(klono,klevo)
48           REAL fm_therm(klono,klevo),en_therm(klono,klevo)
49
50          REAL mfu2(imo,jmo+1,klevo), mfd2(imo,jmo+1,klevo)
51          REAL en_u2(imo,jmo+1,klevo), de_u2(imo,jmo+1,klevo)
52          REAL en_d2(imo,jmo+1,klevo), de_d2(imo,jmo+1,klevo)
53          REAL coefh2(imo,jmo+1,klevo)
54           REAL fm_therm2(imo,jmo+1,klevo)
55           REAL en_therm2(imo,jmo+1,klevo)
56
57          REAL pl(klevo)
58          integer irec
59          integer xid,yid,zid,tid
60          real zrec,zklono,zklevo,zim,zjm
61          integer ncrec,ncklono,ncklevo,ncim,ncjm
62
63          real airefi(klono)
64          character*20 namedim
65
66c  !! attention !!
67c attention il y a aussi le pb de def klono
68c dim de phis??
69         
70         
71          REAL frac_impa(klono,klevo), frac_nucl(klono,klevo)
72          REAL frac_impa2(imo,jmo+1,klevo),
73     .     frac_nucl2(imo,jmo+1,klevo)
74          REAL pyu1(klono), pyv1(klono)
75          REAL pyu12(imo,jmo+1), pyv12(imo,jmo+1)
76          REAL ftsol(klono,nbsrf)
77          REAL psrf(klono,nbsrf)
78          REAL ftsol1(klono),ftsol2(klono),ftsol3(klono),ftsol4(klono)
79          REAL psrf1(klono),psrf2(klono),psrf3(klono),psrf4(klono)
80          REAL ftsol12(imo,jmo+1),ftsol22(imo,jmo+1),
81     .     ftsol32(imo,jmo+1),
82     .     ftsol42(imo,jmo+1)
83          REAL psrf12(imo,jmo+1),psrf22(imo,jmo+1),psrf32(imo,jmo+1),
84     .     psrf42(imo,jmo+1)
85                REAL t(klono,klevo)
86                REAL t2(imo,jmo+1,klevo)       
87          integer ncidp
88          save ncidp
89                integer varidt
90          integer varidmfu, varidmfd, varidps, varidenu, variddeu       
91          integer varidend,varidded,varidch,varidfi,varidfn
92           integer varidfmth,varidenth
93          integer varidyu1,varidyv1,varidpl,varidai,varididvt
94          integer varidfts1,varidfts2,varidfts3,varidfts4
95          integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
96          save varidmfu, varidmfd, varidps, varidenu, variddeu
97          save varidend,varidded,varidch,varidfi,varidfn
98           save varidfmth,varidenth
99          save varidyu1,varidyv1,varidpl,varidai,varididvt
100          save varidfts1,varidfts2,varidfts3,varidfts4
101          save varidpsr1,varidpsr2,varidpsr3,varidpsr4
102                save varidt
103
104          integer l, i
105          integer start(4),count(4),status
106          real rcode
107          logical first
108          save first
109          data first/.true./
110
111
112
113c ---------------------------------------------
114c   Initialisation de la lecture des fichiers
115c ---------------------------------------------
116
117      if (irec .eq. 0) then
118
119            rcode=nf90_open('phystoke.nc',nf90_nowrite,ncidp)
120
121            rcode = nf90_inq_varid(ncidp, 'phis', varidps)
122            print*,'ncidp,varidps',ncidp,varidps
123
124            rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
125            print*,'ncidp,varidpl',ncidp,varidpl
126
127            rcode = nf90_inq_varid(ncidp, 'aire', varidai)
128            print*,'ncidp,varidai',ncidp,varidai
129
130c A FAIRE: Es-il necessaire de stocke t?
131                rcode = nf90_inq_varid(ncidp, 't', varidt)
132                print*,'ncidp,varidt',ncidp,varidt
133
134            rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
135            print*,'ncidp,varidmfu',ncidp,varidmfu
136
137            rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
138            print*,'ncidp,varidmfd',ncidp,varidmfd
139
140            rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
141            print*,'ncidp,varidenu',ncidp,varidenu
142
143            rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
144            print*,'ncidp,variddeu',ncidp,variddeu
145
146            rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
147            print*,'ncidp,varidend',ncidp,varidend
148       
149            rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
150            print*,'ncidp,varidded',ncidp,varidded
151       
152            rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
153            print*,'ncidp,varidch',ncidp,varidch
154       
155c abder (pour thermiques)
156             rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
157             print*,'ncidp,varidfmth',ncidp,varidfmth
158
159             rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
160             print*,'ncidp,varidenth',ncidp,varidenth
161
162            rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
163            print*,'ncidp,varidfi',ncidp,varidfi
164       
165            rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
166            print*,'ncidp,varidfn',ncidp,varidfn
167       
168            rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
169            print*,'ncidp,varidyu1',ncidp,varidyu1
170       
171            rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
172            print*,'ncidp,varidyv1',ncidp,varidyv1
173       
174            rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
175            print*,'ncidp,varidfts1',ncidp,varidfts1
176       
177            rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
178            print*,'ncidp,varidfts2',ncidp,varidfts2
179         
180            rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
181            print*,'ncidp,varidfts3',ncidp,varidfts3
182 
183            rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
184            print*,'ncidp,varidfts4',ncidp,varidfts4
185       
186            rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
187            print*,'ncidp,varidpsr1',ncidp,varidpsr1
188       
189            rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
190            print*,'ncidp,varidpsr2',ncidp,varidpsr2
191       
192            rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
193            print*,'ncidp,varidpsr3',ncidp,varidpsr3
194
195            rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
196            print*,'ncidp,varidpsr4',ncidp,varidpsr4
197       
198c ID pour les dimensions
199
200            status = nf_inq_dimid(ncidp,'y',yid)
201            status = nf_inq_dimid(ncidp,'x',xid)
202            status = nf_inq_dimid(ncidp,'sig_s',zid)
203            status = nf_inq_dimid(ncidp,'time_counter',tid)
204
205c lecture des dimensions
206
207            status = nf_inq_dim(ncidp,yid,namedim,ncjm)
208            status = nf_inq_dim(ncidp,xid,namedim,ncim)
209            status = nf_inq_dim(ncidp,zid,namedim,ncklevo)
210            status = nf_inq_dim(ncidp,tid,namedim,ncrec)
211       
212            zrec=ncrec
213            zklevo=ncklevo
214            zim=ncim
215            zjm=ncjm
216       
217            zklono=zim*(zjm-2)+2
218       
219            write(*,*) 'read_pstoke : zrec = ', zrec
220            write(*,*) 'read_pstoke : zklevo = ', zklevo
221            write(*,*) 'read_pstoke : zim = ', zim
222            write(*,*) 'read_pstoke : zjm = ', zjm
223            write(*,*) 'read_pstoke : zklono = ', zklono
224
225c niveaux de pression
226#ifdef NC_DOUBLE
227      status=NF_GET_VARA_DOUBLE(ncidp,varidpl,1,zklevo,pl)
228#else
229      status=NF_GET_VARA_REAL(ncidp,varidpl,1,zklevo,pl)
230#endif
231
232c lecture de aire et phis
233       
234      start(1)=1
235      start(2)=1
236      start(3)=1
237      start(4)=0
238
239      count(1)=zim
240      count(2)=zjm
241      count(3)=1
242      count(4)=0
243
244c phis
245#ifdef NC_DOUBLE
246      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
247#else
248      status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
249#endif
250      call gr_ecrit_fi(1,klono,imo,jmo+1,phisfi2,phisfi)
251
252c aire
253#ifdef NC_DOUBLE
254      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
255#else
256      status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
257#endif
258       call gr_ecrit_fi(1,klono,imo,jmo+1,airefi2,airefi)
259      else
260
261      print*,'ok1'
262
263c ---------------------
264c   lecture des champs
265c ---------------------
266       
267        print*,'WARNING!!! Il n y a pas de test de coherence'
268        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
269
270      start(1)=1
271      start(2)=1
272      start(3)=1
273      start(4)=irec
274
275      count(1)=zim
276      count(2)=zjm
277      count(3)=zklevo
278      count(4)=1
279
280
281C *** Lessivage******************************************************
282c frac_impa
283#ifdef NC_DOUBLE
284      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
285#else
286      status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
287#endif
288      call gr_ecrit_fi(klevo,klono,imo,jmo+1,frac_impa2,frac_impa)
289
290c frac_nucl
291#ifdef NC_DOUBLE
292      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
293#else
294      status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
295#endif
296      call gr_ecrit_fi(klevo,klono,imo,jmo+1,frac_nucl2,frac_nucl)
297
298C*** Temperature ******************************************************
299c abder t
300#ifdef NC_DOUBLE
301      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
302#else
303      status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
304#endif
305      call gr_ecrit_fi(klevo,klono,imo,jmo+1,t2,t)
306
307C*** Flux pour le calcul de la convection TIEDTK ***********************
308c mfu
309#ifdef NC_DOUBLE
310      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
311#else
312      status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
313#endif
314      call gr_ecrit_fi(klevo,klono,imo,jmo+1,mfu2,mfu)
315
316c mfd
317#ifdef NC_DOUBLE
318      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
319#else
320      status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
321#endif
322      call gr_ecrit_fi(klevo,klono,imo,jmo+1,mfd2,mfd)
323
324c en_u
325#ifdef NC_DOUBLE
326      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
327#else
328      status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
329#endif
330      call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_u2,en_u)
331
332c de_u
333#ifdef NC_DOUBLE
334      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
335#else
336      status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
337#endif
338      call gr_ecrit_fi(klevo,klono,imo,jmo+1,de_u2,de_u)
339
340c en_d
341#ifdef NC_DOUBLE
342      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
343#else
344      status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
345#endif
346      call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_d2,en_d)
347
348c de_d
349#ifdef NC_DOUBLE
350      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
351#else
352      status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
353#endif
354      call gr_ecrit_fi(klevo,klono,imo,jmo+1,de_d2,de_d)
355
356C **** Coeffecient du mellange turbulent**********************************
357c coefh
358#ifdef NC_DOUBLE
359      status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
360#else
361      status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
362#endif
363       call gr_ecrit_fi(klevo,klono,imo,jmo+1,coefh2,coefh)
364
365C*** Flux ascendant et entrant pour les Thermiques************************
366cabder thermiques
367#ifdef NC_DOUBLE
368      status=NF_GET_VARA_DOUBLE(ncidp,varidfmth,start,count,fm_therm2)
369#else
370      status=NF_GET_VARA_REAL(ncidp,varidfmth,start,count,fm_therm2)
371#endif
372      call gr_ecrit_fi(klevo,klono,imo,jmo+1,fm_therm2,fm_therm)
373
374#ifdef NC_DOUBLE
375      status=NF_GET_VARA_DOUBLE(ncidp,varidenth,start,count,en_therm2)
376#else
377      status=NF_GET_VARA_REAL(ncidp,varidenth,start,count,en_therm2)
378#endif
379      call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_therm2,en_therm)
380
381C*** Vitesses aux sol ******************************************************
382      start(3)=irec
383      start(4)=0
384      count(3)=1
385      count(4)=0
386c pyu1
387#ifdef NC_DOUBLE
388      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
389#else
390      status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
391#endif
392      call gr_ecrit_fi(1,klono,imo,jmo+1,pyu12,pyu1)
393
394c pyv1
395#ifdef NC_DOUBLE
396      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
397#else
398      status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
399#endif
400      call gr_ecrit_fi(1,klono,imo,jmo+1,pyv12,pyv1)
401
402C*** Temperature au sol ********************************************
403c ftsol1
404#ifdef NC_DOUBLE
405      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
406#else
407      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
408#endif
409       call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol12,ftsol1)
410
411c ftsol2
412#ifdef NC_DOUBLE
413      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
414#else
415      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
416#endif
417      call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol22,ftsol2)
418
419c ftsol3
420#ifdef NC_DOUBLE
421      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
422#else
423      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
424#endif
425      call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol32,ftsol3)
426
427c ftsol4
428#ifdef NC_DOUBLE
429      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
430#else
431      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
432#endif
433      call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol42,ftsol4)
434
435C*** Nature du sol **************************************************
436c psrf1
437#ifdef NC_DOUBLE
438      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
439#else
440      status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
441#endif
442      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf12,psrf1)
443
444c psrf2
445#ifdef NC_DOUBLE
446      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
447#else
448      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
449#endif
450      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf22,psrf2)
451
452c psrf3
453#ifdef NC_DOUBLE
454      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
455#else
456      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
457#endif
458      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf32,psrf3)
459
460c psrf4
461#ifdef NC_DOUBLE
462      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
463#else
464      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
465#endif
466      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf42,psrf4)
467       
468          do i = 1,klono
469       
470        psrf(i,1) = psrf1(i)
471        psrf(i,2) = psrf2(i)
472        psrf(i,3) = psrf3(i)
473        psrf(i,4) = psrf4(i)
474 
475        ftsol(i,1) = ftsol1(i)
476        ftsol(i,2) = ftsol2(i)
477        ftsol(i,3) = ftsol3(i)
478        ftsol(i,4) = ftsol4(i)
479       
480          enddo
481       
482        endif
483       
484        return
485       
486        end
487
Note: See TracBrowser for help on using the repository browser.