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