source: LMDZ4/branches/V3_test/libf/phylmd/read_pstoke0.F @ 4289

Last change on this file since 4289 was 541, checked in by lmdzadmin, 20 years ago

Convergence avec la version d'Olivia Coindreau incluant:

  • le offline
  • les thermiques
  • mellor & yamada dans la couche limite

LF

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