LMDZ
read_pstoke.F90
Go to the documentation of this file.
1 
2 ! $Id: read_pstoke.F90 2345 2015-08-21 09:57:36Z emillour $
3 
4 
5 
6 SUBROUTINE read_pstoke(irec, zrec, zklono, zklevo, airefi, phisfi, t, mfu, &
7  mfd, en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, &
8  frac_nucl, pyu1, pyv1, ftsol, psrf)
9 
10  ! ******************************************************************************
11  ! Frederic HOURDIN, Abderrahmane IDELKADI
12  ! Lecture des parametres physique stockes online necessaires pour
13  ! recalculer offline le transport de traceurs sur une grille 2x plus fine
14  ! que
15  ! celle online
16  ! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
17  ! ******************************************************************************
18 
19  USE netcdf
20  USE dimphy
21  USE indice_sol_mod
22  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
23 
24  IMPLICIT NONE
25 
26  include "netcdf.inc"
27 
28  INTEGER klono, klevo, imo, jmo
29 ! PARAMETER (imo=iim/2, jmo=(jjm+1)/2)
30 ! PARAMETER (klono=(jmo-1)*imo+2, klevo=llm)
31  REAL :: phisfi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !phisfi(klono)
32  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(imo,jmo+1)
33  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(imo, jmo+1)
34 
35  REAL :: mfu(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfu(klono, klevo)
36  REAL :: mfd(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfd(klono, klevo)
37  REAL :: en_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_u(klono, klevo)
38  REAL :: de_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_u(klono, klevo)
39  REAL :: en_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_d(klono, klevo)
40  REAL :: de_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_d(klono, klevo)
41  REAL :: coefh(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !coefh(klono, klevo)
42  REAL :: fm_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !fm_therm(klono, klevo)
43  REAL :: en_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_therm(klono, klevo)
44 
45  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(imo, jmo+1, klevo)
46  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(imo, jmo+1, klevo)
47  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(imo, jmo+1, klevo)
48  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(imo, jmo+1, klevo)
49  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(imo, jmo+1, klevo)
50  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(imo, jmo+1, klevo)
51  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(imo, jmo+1, klevo)
52  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(imo, jmo+1, klevo)
53  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(imo, jmo+1, klevo)
54 
55  REAL,ALLOCATABLE :: pl(:) !pl(klevo)
56  INTEGER irec
57  INTEGER xid, yid, zid, tid
58  REAL zrec, zklono, zklevo, zim, zjm
59  INTEGER ncrec, ncklono, ncklevo, ncim, ncjm
60 
61  REAL :: airefi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !airefi(klono)
62  CHARACTER *20 namedim
63 
64  ! !! attention !!
65  ! attention il y a aussi le pb de def klono
66  ! dim de phis??
67 
68 
69  REAL :: frac_impa(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_impa(klono, klevo)
70  REAL :: frac_nucl(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_nucl(klono, klevo)
71  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(imo, jmo+1, klevo)
72  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(imo, jmo+1, klevo)
73  REAL :: pyu1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyu1(klono)
74  REAL :: pyv1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyv1(klono)
75  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(imo, jmo+1), pyv12(imo, jmo+1)
76  REAL :: ftsol(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !ftsol(klono, nbsrf)
77  REAL :: psrf(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !psrf(klono, nbsrf)
78  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(klono), ftsol2(klono)
79  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(klono), ftsol4(klono)
80  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(klono), psrf2(klono)
81  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(klono), psrf4(klono)
82  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(imo, jmo+1)
83  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(imo, jmo+1)
84  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(imo, jmo+1)
85  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(imo, jmo+1)
86  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(imo, jmo+1)
87  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(imo, jmo+1)
88  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(imo, jmo+1)
89  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(imo, jmo+1)
90  REAL :: t(((nbp_lon/2)-1)*(nbp_lat/2)+2,nbp_lev) !t(klono, klevo)
91  REAL,ALLOCATABLE :: t2(:,:,:) !t2(imo, jmo+1, klevo)
92  INTEGER,SAVE :: ncidp
93  INTEGER,SAVE :: varidt
94  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
95  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
96  INTEGER,SAVE :: varidfmth, varidenth
97  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
98  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
99  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
100 
101  INTEGER l, i
102  INTEGER start(4), count(4), status
103  REAL rcode
104  LOGICAL,SAVE :: first=.true.
105 
106  ! Allocate arrays
107  imo=nbp_lon/2
108  jmo=nbp_lat/2
109  klono=(jmo-1)*imo+2
110  klevo=nbp_lev
111 
112  ALLOCATE(phisfi2(imo,jmo+1))
113  ALLOCATE(airefi2(imo, jmo+1))
114  ALLOCATE(mfu2(imo, jmo+1, klevo))
115  ALLOCATE(mfd2(imo, jmo+1, klevo))
116  ALLOCATE(en_u2(imo, jmo+1, klevo))
117  ALLOCATE(de_u2(imo, jmo+1, klevo))
118  ALLOCATE(en_d2(imo, jmo+1, klevo))
119  ALLOCATE(de_d2(imo, jmo+1, klevo))
120  ALLOCATE(coefh2(imo, jmo+1, klevo))
121  ALLOCATE(fm_therm2(imo, jmo+1, klevo))
122  ALLOCATE(en_therm2(imo, jmo+1, klevo))
123  ALLOCATE(pl(klevo))
124  ALLOCATE(frac_impa2(imo, jmo+1, klevo))
125  ALLOCATE(frac_nucl2(imo, jmo+1, klevo))
126  ALLOCATE(pyu12(imo, jmo+1), pyv12(imo, jmo+1))
127  ALLOCATE(ftsol1(klono), ftsol2(klono))
128  ALLOCATE(ftsol3(klono), ftsol4(klono))
129  ALLOCATE(psrf1(klono), psrf2(klono))
130  ALLOCATE(psrf3(klono), psrf4(klono))
131  ALLOCATE(ftsol12(imo, jmo+1))
132  ALLOCATE(ftsol22(imo, jmo+1))
133  ALLOCATE(ftsol32(imo, jmo+1))
134  ALLOCATE(ftsol42(imo, jmo+1))
135  ALLOCATE(psrf12(imo, jmo+1))
136  ALLOCATE(psrf22(imo, jmo+1))
137  ALLOCATE(psrf32(imo, jmo+1))
138  ALLOCATE(psrf42(imo, jmo+1))
139  ALLOCATE(t2(imo, jmo+1, klevo))
140 
141  ! ---------------------------------------------
142  ! Initialisation de la lecture des fichiers
143  ! ---------------------------------------------
144 
145  IF (irec==0) THEN
146 
147  rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp)
148 
149  rcode = nf90_inq_varid(ncidp, 'phis', varidps)
150  print *, 'ncidp,varidps', ncidp, varidps
151 
152  rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
153  print *, 'ncidp,varidpl', ncidp, varidpl
154 
155  rcode = nf90_inq_varid(ncidp, 'aire', varidai)
156  print *, 'ncidp,varidai', ncidp, varidai
157 
158  ! A FAIRE: Es-il necessaire de stocke t?
159  rcode = nf90_inq_varid(ncidp, 't', varidt)
160  print *, 'ncidp,varidt', ncidp, varidt
161 
162  rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
163  print *, 'ncidp,varidmfu', ncidp, varidmfu
164 
165  rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
166  print *, 'ncidp,varidmfd', ncidp, varidmfd
167 
168  rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
169  print *, 'ncidp,varidenu', ncidp, varidenu
170 
171  rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
172  print *, 'ncidp,variddeu', ncidp, variddeu
173 
174  rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
175  print *, 'ncidp,varidend', ncidp, varidend
176 
177  rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
178  print *, 'ncidp,varidded', ncidp, varidded
179 
180  rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
181  print *, 'ncidp,varidch', ncidp, varidch
182 
183  ! abder (pour thermiques)
184  rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
185  print *, 'ncidp,varidfmth', ncidp, varidfmth
186 
187  rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
188  print *, 'ncidp,varidenth', ncidp, varidenth
189 
190  rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
191  print *, 'ncidp,varidfi', ncidp, varidfi
192 
193  rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
194  print *, 'ncidp,varidfn', ncidp, varidfn
195 
196  rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
197  print *, 'ncidp,varidyu1', ncidp, varidyu1
198 
199  rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
200  print *, 'ncidp,varidyv1', ncidp, varidyv1
201 
202  rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
203  print *, 'ncidp,varidfts1', ncidp, varidfts1
204 
205  rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
206  print *, 'ncidp,varidfts2', ncidp, varidfts2
207 
208  rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
209  print *, 'ncidp,varidfts3', ncidp, varidfts3
210 
211  rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
212  print *, 'ncidp,varidfts4', ncidp, varidfts4
213 
214  rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
215  print *, 'ncidp,varidpsr1', ncidp, varidpsr1
216 
217  rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
218  print *, 'ncidp,varidpsr2', ncidp, varidpsr2
219 
220  rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
221  print *, 'ncidp,varidpsr3', ncidp, varidpsr3
222 
223  rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
224  print *, 'ncidp,varidpsr4', ncidp, varidpsr4
225 
226  ! ID pour les dimensions
227 
228  status = nf_inq_dimid(ncidp, 'y', yid)
229  status = nf_inq_dimid(ncidp, 'x', xid)
230  status = nf_inq_dimid(ncidp, 'sig_s', zid)
231  status = nf_inq_dimid(ncidp, 'time_counter', tid)
232 
233  ! lecture des dimensions
234 
235  status = nf_inq_dim(ncidp, yid, namedim, ncjm)
236  status = nf_inq_dim(ncidp, xid, namedim, ncim)
237  status = nf_inq_dim(ncidp, zid, namedim, ncklevo)
238  status = nf_inq_dim(ncidp, tid, namedim, ncrec)
239 
240  zrec = ncrec
241  zklevo = ncklevo
242  zim = ncim
243  zjm = ncjm
244 
245  zklono = zim*(zjm-2) + 2
246 
247  WRITE (*, *) 'read_pstoke : zrec = ', zrec
248  WRITE (*, *) 'read_pstoke : zklevo = ', zklevo
249  WRITE (*, *) 'read_pstoke : zim = ', zim
250  WRITE (*, *) 'read_pstoke : zjm = ', zjm
251  WRITE (*, *) 'read_pstoke : zklono = ', zklono
252 
253  ! niveaux de pression
254 #ifdef NC_DOUBLE
255  status = nf_get_vara_double(ncidp, varidpl, 1, zklevo, pl)
256 #else
257  status = nf_get_vara_real(ncidp, varidpl, 1, zklevo, pl)
258 #endif
259 
260  ! lecture de aire et phis
261 
262  start(1) = 1
263  start(2) = 1
264  start(3) = 1
265  start(4) = 0
266 
267  count(1) = zim
268  count(2) = zjm
269  count(3) = 1
270  count(4) = 0
271 
272  ! phis
273 #ifdef NC_DOUBLE
274  status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2)
275 #else
276  status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2)
277 #endif
278  CALL gr_ecrit_fi(1, klono, imo, jmo+1, phisfi2, phisfi)
279 
280  ! aire
281 #ifdef NC_DOUBLE
282  status = nf_get_vara_double(ncidp, varidai, start, count, airefi2)
283 #else
284  status = nf_get_vara_real(ncidp, varidai, start, count, airefi2)
285 #endif
286  CALL gr_ecrit_fi(1, klono, imo, jmo+1, airefi2, airefi)
287  ELSE
288 
289  print *, 'ok1'
290 
291  ! ---------------------
292  ! lecture des champs
293  ! ---------------------
294 
295  print *, 'WARNING!!! Il n y a pas de test de coherence'
296  print *, 'sur le nombre de niveaux verticaux dans le fichier nc'
297 
298  start(1) = 1
299  start(2) = 1
300  start(3) = 1
301  start(4) = irec
302 
303  count(1) = zim
304  count(2) = zjm
305  count(3) = zklevo
306  count(4) = 1
307 
308 
309  ! *** Lessivage******************************************************
310  ! frac_impa
311 #ifdef NC_DOUBLE
312  status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2)
313 #else
314  status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2)
315 #endif
316  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, frac_impa2, frac_impa)
317 
318  ! frac_nucl
319 #ifdef NC_DOUBLE
320  status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2)
321 #else
322  status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2)
323 #endif
324  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, frac_nucl2, frac_nucl)
325 
326  ! *** Temperature ******************************************************
327  ! abder t
328 #ifdef NC_DOUBLE
329  status = nf_get_vara_double(ncidp, varidt, start, count, t2)
330 #else
331  status = nf_get_vara_real(ncidp, varidt, start, count, t2)
332 #endif
333  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, t2, t)
334 
335  ! *** Flux pour le calcul de la convection TIEDTK ***********************
336  ! mfu
337 #ifdef NC_DOUBLE
338  status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2)
339 #else
340  status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2)
341 #endif
342  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, mfu2, mfu)
343 
344  ! mfd
345 #ifdef NC_DOUBLE
346  status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2)
347 #else
348  status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2)
349 #endif
350  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, mfd2, mfd)
351 
352  ! en_u
353 #ifdef NC_DOUBLE
354  status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2)
355 #else
356  status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2)
357 #endif
358  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_u2, en_u)
359 
360  ! de_u
361 #ifdef NC_DOUBLE
362  status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2)
363 #else
364  status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2)
365 #endif
366  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, de_u2, de_u)
367 
368  ! en_d
369 #ifdef NC_DOUBLE
370  status = nf_get_vara_double(ncidp, varidend, start, count, en_d2)
371 #else
372  status = nf_get_vara_real(ncidp, varidend, start, count, en_d2)
373 #endif
374  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_d2, en_d)
375 
376  ! de_d
377 #ifdef NC_DOUBLE
378  status = nf_get_vara_double(ncidp, varidded, start, count, de_d2)
379 #else
380  status = nf_get_vara_real(ncidp, varidded, start, count, de_d2)
381 #endif
382  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, de_d2, de_d)
383 
384  ! **** Coeffecient du mellange
385  ! turbulent**********************************
386  ! coefh
387 #ifdef NC_DOUBLE
388  status = nf_get_vara_double(ncidp, varidch, start, count, coefh2)
389 #else
390  status = nf_get_vara_real(ncidp, varidch, start, count, coefh2)
391 #endif
392  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, coefh2, coefh)
393 
394  ! *** Flux ascendant et entrant pour les
395  ! Thermiques************************
396  ! abder thermiques
397 #ifdef NC_DOUBLE
398  status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2)
399 #else
400  status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2)
401 #endif
402  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, fm_therm2, fm_therm)
403 
404 #ifdef NC_DOUBLE
405  status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2)
406 #else
407  status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2)
408 #endif
409  CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_therm2, en_therm)
410 
411  ! *** Vitesses aux sol
412  ! ******************************************************
413  start(3) = irec
414  start(4) = 0
415  count(3) = 1
416  count(4) = 0
417  ! pyu1
418 #ifdef NC_DOUBLE
419  status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12)
420 #else
421  status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12)
422 #endif
423  CALL gr_ecrit_fi(1, klono, imo, jmo+1, pyu12, pyu1)
424 
425  ! pyv1
426 #ifdef NC_DOUBLE
427  status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12)
428 #else
429  status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12)
430 #endif
431  CALL gr_ecrit_fi(1, klono, imo, jmo+1, pyv12, pyv1)
432 
433  ! *** Temperature au sol ********************************************
434  ! ftsol1
435 #ifdef NC_DOUBLE
436  status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12)
437 #else
438  status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12)
439 #endif
440  CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol12, ftsol1)
441 
442  ! ftsol2
443 #ifdef NC_DOUBLE
444  status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22)
445 #else
446  status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22)
447 #endif
448  CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol22, ftsol2)
449 
450  ! ftsol3
451 #ifdef NC_DOUBLE
452  status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32)
453 #else
454  status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32)
455 #endif
456  CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol32, ftsol3)
457 
458  ! ftsol4
459 #ifdef NC_DOUBLE
460  status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42)
461 #else
462  status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42)
463 #endif
464  CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol42, ftsol4)
465 
466  ! *** Nature du sol **************************************************
467  ! psrf1
468 #ifdef NC_DOUBLE
469  status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12)
470 #else
471  status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12)
472 #endif
473  CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf12, psrf1)
474 
475  ! psrf2
476 #ifdef NC_DOUBLE
477  status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22)
478 #else
479  status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22)
480 #endif
481  CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf22, psrf2)
482 
483  ! psrf3
484 #ifdef NC_DOUBLE
485  status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32)
486 #else
487  status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32)
488 #endif
489  CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf32, psrf3)
490 
491  ! psrf4
492 #ifdef NC_DOUBLE
493  status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42)
494 #else
495  status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42)
496 #endif
497  CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf42, psrf4)
498 
499  DO i = 1, klono
500 
501  psrf(i, 1) = psrf1(i)
502  psrf(i, 2) = psrf2(i)
503  psrf(i, 3) = psrf3(i)
504  psrf(i, 4) = psrf4(i)
505 
506  ftsol(i, 1) = ftsol1(i)
507  ftsol(i, 2) = ftsol2(i)
508  ftsol(i, 3) = ftsol3(i)
509  ftsol(i, 4) = ftsol4(i)
510 
511  END DO
512 
513  END IF
514 
515  RETURN
516 
517 END SUBROUTINE read_pstoke
518 
mod_grid_phy_lmdz::nbp_lev
integer, save nbp_lev
Definition: mod_grid_phy_lmdz.F90:17
read_pstoke
subroutine read_pstoke(irec, zrec, zklono, zklevo, airefi, phisfi, t, mfu, mfd, en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, frac_nucl, pyu1, pyv1, ftsol, psrf)
Definition: read_pstoke.F90:9
mod_grid_phy_lmdz::nbp_lat
integer, save nbp_lat
Definition: mod_grid_phy_lmdz.F90:16
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
mod_grid_phy_lmdz
Definition: mod_grid_phy_lmdz.F90:4
dimphy
Definition: dimphy.F90:1
indice_sol_mod
Definition: indice_sol_mod.F90:1
mod_grid_phy_lmdz::nbp_lon
integer, save nbp_lon
Definition: mod_grid_phy_lmdz.F90:15