LMDZ
read_pstoke0.F90
Go to the documentation of this file.
1 
2 ! $Id: read_pstoke0.F90 2345 2015-08-21 09:57:36Z emillour $
3 
4 
5 
6 SUBROUTINE read_pstoke0(irec, zrec, zkon, zkev, airefi, phisfi, t, mfu, mfd, &
7  en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, frac_nucl, &
8  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 des traceurs sur la meme grille que
14  ! online
15  ! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
16  ! ******************************************************************************
17 
18  USE netcdf
19  USE dimphy
20  USE indice_sol_mod
21  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
22 
23  IMPLICIT NONE
24 
25  include "netcdf.inc"
26 
27  INTEGER kon, kev, zkon, zkev
28 ! PARAMETER (kon=iim*(jjm-1)+2, kev=llm)
29  REAL :: phisfi(nbp_lon*(nbp_lat-2)+2) !phisfi(kon)
30  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(nbp_lon, nbp_lat)
31  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(nbp_lon, nbp_lat)
32 
33  REAL :: mfu(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfu(kon, kev)
34  REAL :: mfd(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfd(kon, kev)
35  REAL :: en_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_u(kon, kev)
36  REAL :: de_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_u(kon, kev)
37  REAL :: en_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_d(kon, kev)
38  REAL :: de_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_d(kon, kev)
39  REAL :: coefh(nbp_lon*(nbp_lat-2)+2,nbp_lev) !coefh(kon, kev)
40 
41  ! abd 25 11 02
42  ! Thermiques
43  REAL :: fm_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !fm_therm(kon, kev)
44  REAL :: en_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_therm(kon, kev)
45  REAL :: t(nbp_lon*(nbp_lat-2)+2,nbp_lev) !t(kon, kev)
46 
47  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(nbp_lon, nbp_lat, kev)
48  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(nbp_lon, nbp_lat, kev)
49  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(nbp_lon, nbp_lat, kev)
50  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(nbp_lon, nbp_lat, kev)
51  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(nbp_lon, nbp_lat, kev)
52  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(nbp_lon, nbp_lat, kev)
53  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(nbp_lon, nbp_lat, kev)
54  REAL,ALLOCATABLE :: t2(:,:,:) !t2(nbp_lon, nbp_lat, kev)
55  ! Thermiques
56  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(nbp_lon, nbp_lat, kev)
57  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(nbp_lon, nbp_lat, kev)
58 
59  REAL,ALLOCATABLE :: pl(:) !pl(kev)
60  INTEGER irec
61  INTEGER xid, yid, zid, tid
62  INTEGER zrec, zim, zjm
63  INTEGER ncrec, nckon, nckev, ncim, ncjm
64 
65  REAL :: airefi(nbp_lon*(nbp_lat-2)+2) !airefi(kon)
66  CHARACTER *20 namedim
67 
68  ! !! attention !!
69  ! attention il y a aussi le pb de def kon
70  ! dim de phis??
71 
72  REAL :: frac_impa(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_impa(kon, kev)
73  REAL :: frac_nucl(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_nucl(kon, kev)
74  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(nbp_lon, nbp_lat, kev)
75  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(nbp_lon, nbp_lat, kev)
76  REAL :: pyu1(nbp_lon*(nbp_lat-2)+2) !pyu1(kon)
77  REAL :: pyv1(nbp_lon*(nbp_lat-2)+2) !pyv1(kon)
78  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat)
79  REAL :: ftsol(nbp_lon*(nbp_lat-2)+2,nbp_lev) !ftsol(kon, nbsrf)
80  REAL :: psrf(nbp_lon*(nbp_lat-2)+2,nbp_lev) !psrf(kon, nbsrf)
81  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(kon), ftsol2(kon)
82  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(kon), ftsol4(kon)
83  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(kon), psrf2(kon)
84  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(kon), psrf4(kon)
85  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(nbp_lon, nbp_lat)
86  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(nbp_lon, nbp_lat)
87  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(nbp_lon, nbp_lat)
88  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(nbp_lon, nbp_lat)
89  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(nbp_lon, nbp_lat)
90  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(nbp_lon, nbp_lat)
91  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(nbp_lon, nbp_lat)
92  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(nbp_lon, nbp_lat)
93 
94  INTEGER,SAVE :: ncidp
95  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
96  INTEGER,SAVE :: varidt
97  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
98  ! therm
99  INTEGER,SAVE :: varidfmth, varidenth
100  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
101  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
102  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
103 
104  INTEGER l, i
105  INTEGER start(4), count(4), status
106  REAL rcode
107  LOGICAL,SAVE :: first=.true.
108 
109  ! Allocate arrays
110  kon=nbp_lon*(nbp_lat-2)+2
111  kev=nbp_lev
112 
113  ALLOCATE(phisfi2(nbp_lon, nbp_lat))
114  ALLOCATE(airefi2(nbp_lon, nbp_lat))
115  ALLOCATE(mfu2(nbp_lon, nbp_lat, kev))
116  ALLOCATE(mfd2(nbp_lon, nbp_lat, kev))
117  ALLOCATE(en_u2(nbp_lon, nbp_lat, kev))
118  ALLOCATE(de_u2(nbp_lon, nbp_lat, kev))
119  ALLOCATE(en_d2(nbp_lon, nbp_lat, kev))
120  ALLOCATE(de_d2(nbp_lon, nbp_lat, kev))
121  ALLOCATE(coefh2(nbp_lon, nbp_lat, kev))
122  ALLOCATE(t2(nbp_lon, nbp_lat, kev))
123  ALLOCATE(fm_therm2(nbp_lon, nbp_lat, kev))
124  ALLOCATE(en_therm2(nbp_lon, nbp_lat, kev))
125  ALLOCATE(pl(kev))
126  ALLOCATE(frac_impa2(nbp_lon, nbp_lat, kev))
127  ALLOCATE(frac_nucl2(nbp_lon, nbp_lat, kev))
128  ALLOCATE(pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat))
129  ALLOCATE(ftsol1(kon), ftsol2(kon))
130  ALLOCATE(ftsol3(kon), ftsol4(kon))
131  ALLOCATE(psrf1(kon), psrf2(kon))
132  ALLOCATE(psrf3(kon), psrf4(kon))
133  ALLOCATE(ftsol12(nbp_lon, nbp_lat))
134  ALLOCATE(ftsol22(nbp_lon, nbp_lat))
135  ALLOCATE(ftsol32(nbp_lon, nbp_lat))
136  ALLOCATE(ftsol42(nbp_lon, nbp_lat))
137  ALLOCATE(psrf12(nbp_lon, nbp_lat))
138  ALLOCATE(psrf22(nbp_lon, nbp_lat))
139  ALLOCATE(psrf32(nbp_lon, nbp_lat))
140  ALLOCATE(psrf42(nbp_lon, nbp_lat))
141 
142  ! ---------------------------------------------
143  ! Initialisation de la lecture des fichiers
144  ! ---------------------------------------------
145 
146  IF (irec==0) THEN
147 
148  rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp)
149 
150  rcode = nf90_inq_varid(ncidp, 'phis', varidps)
151  print *, 'ncidp,varidps', ncidp, varidps
152 
153  rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
154  print *, 'ncidp,varidpl', ncidp, varidpl
155 
156  rcode = nf90_inq_varid(ncidp, 'aire', varidai)
157  print *, 'ncidp,varidai', ncidp, varidai
158 
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  ! 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, nckev)
238  status = nf_inq_dim(ncidp, tid, namedim, ncrec)
239 
240  zrec = ncrec
241  zkev = nckev
242  zim = ncim
243  zjm = ncjm
244 
245  zkon = zim*(zjm-2) + 2
246 
247  WRITE (*, *) 'read_pstoke : zrec = ', zrec
248  WRITE (*, *) 'read_pstoke : kev = ', zkev
249  WRITE (*, *) 'read_pstoke : zim = ', zim
250  WRITE (*, *) 'read_pstoke : zjm = ', zjm
251  WRITE (*, *) 'read_pstoke : kon = ', zkon
252 
253  ! niveaux de pression
254 
255  status = nf_get_vara_real(ncidp, varidpl, 1, kev, pl)
256 
257  ! lecture de aire et phis
258 
259  start(1) = 1
260  start(2) = 1
261  start(3) = 1
262  start(4) = 0
263 
264  count(1) = zim
265  count(2) = zjm
266  count(3) = 1
267  count(4) = 0
268 
269 
270  ! **** Geopotentiel au sol ***************************************
271  ! phis
272 #ifdef NC_DOUBLE
273  status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2)
274 #else
275  status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2)
276 #endif
277  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi)
278 
279  ! **** Aires des mails aux sol ************************************
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, kon, nbp_lon, nbp_lat, 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) = kev
306  count(4) = 1
307 
308  ! **** Temperature ********************************************
309  ! A FAIRE : Es-ce necessaire ?
310 
311  ! abder t
312 #ifdef NC_DOUBLE
313  status = nf_get_vara_double(ncidp, varidt, start, count, t2)
314 #else
315  status = nf_get_vara_real(ncidp, varidt, start, count, t2)
316 #endif
317  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t)
318 
319  ! **** Flux pour la convection (Tiedtk)
320  ! ********************************************
321  ! mfu
322 #ifdef NC_DOUBLE
323  status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2)
324 #else
325  status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2)
326 #endif
327  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu)
328 
329  ! mfd
330 #ifdef NC_DOUBLE
331  status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2)
332 #else
333  status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2)
334 #endif
335  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd)
336 
337  ! en_u
338 #ifdef NC_DOUBLE
339  status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2)
340 #else
341  status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2)
342 #endif
343  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u)
344 
345  ! de_u
346 #ifdef NC_DOUBLE
347  status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2)
348 #else
349  status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2)
350 #endif
351  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u)
352 
353  ! en_d
354 #ifdef NC_DOUBLE
355  status = nf_get_vara_double(ncidp, varidend, start, count, en_d2)
356 #else
357  status = nf_get_vara_real(ncidp, varidend, start, count, en_d2)
358 #endif
359  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d)
360 
361  ! de_d
362 #ifdef NC_DOUBLE
363  status = nf_get_vara_double(ncidp, varidded, start, count, de_d2)
364 #else
365  status = nf_get_vara_real(ncidp, varidded, start, count, de_d2)
366 #endif
367  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d)
368 
369  ! **** Coefficient de mellange turbulent
370  ! *******************************************
371  ! coefh
372  print *, 'LECTURE de coefh a irec =', irec
373 #ifdef NC_DOUBLE
374  status = nf_get_vara_double(ncidp, varidch, start, count, coefh2)
375 #else
376  status = nf_get_vara_real(ncidp, varidch, start, count, coefh2)
377 #endif
378  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh)
379  ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ ')
380  ! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ ')
381 
382  ! **** Flux ascendants et entrant dans le thermique
383  ! **********************************
384  ! Thermiques
385  print *, 'LECTURE de fm_therm a irec =', irec
386 #ifdef NC_DOUBLE
387  status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2)
388 #else
389  status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2)
390 #endif
391  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm)
392  print *, 'LECTURE de en_therm a irec =', irec
393 #ifdef NC_DOUBLE
394  status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2)
395 #else
396  status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2)
397 #endif
398  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm)
399 
400  ! **** Coefficients de lessivage
401  ! *******************************************
402  ! frac_impa
403 #ifdef NC_DOUBLE
404  status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2)
405 #else
406  status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2)
407 #endif
408  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa)
409 
410  ! frac_nucl
411 
412 #ifdef NC_DOUBLE
413  status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2)
414 #else
415  status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2)
416 #endif
417  CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl)
418 
419  ! **** Vents aux sol ********************************************
420 
421  start(3) = irec
422  start(4) = 0
423  count(3) = 1
424  count(4) = 0
425 
426  ! pyu1
427  print *, 'LECTURE de yu1 a irec =', irec
428 #ifdef NC_DOUBLE
429  status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12)
430 #else
431  status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12)
432 #endif
433  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1)
434 
435  ! pyv1
436  print *, 'LECTURE de yv1 a irec =', irec
437 #ifdef NC_DOUBLE
438  status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12)
439 #else
440  status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12)
441 #endif
442  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1)
443 
444  ! **** Temerature au sol ********************************************
445  ! ftsol1
446  print *, 'LECTURE de ftsol1 a irec =', irec
447 #ifdef NC_DOUBLE
448  status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12)
449 #else
450  status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12)
451 #endif
452  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1)
453 
454  ! ftsol2
455  print *, 'LECTURE de ftsol2 a irec =', irec
456 #ifdef NC_DOUBLE
457  status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22)
458 #else
459  status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22)
460 #endif
461  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2)
462 
463  ! ftsol3
464  print *, 'LECTURE de ftsol3 a irec =', irec
465 #ifdef NC_DOUBLE
466  status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32)
467 #else
468  status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32)
469 #endif
470  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3)
471 
472  ! ftsol4
473 #ifdef NC_DOUBLE
474  status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42)
475 #else
476  status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42)
477 #endif
478  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4)
479 
480  ! **** Nature sol ********************************************
481  ! psrf1
482 #ifdef NC_DOUBLE
483  status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12)
484 #else
485  status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12)
486 #endif
487  ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
488  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1)
489 
490  ! psrf2
491 #ifdef NC_DOUBLE
492  status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22)
493 #else
494  status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22)
495 #endif
496  ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
497  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2)
498 
499  ! psrf3
500 #ifdef NC_DOUBLE
501  status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32)
502 #else
503  status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32)
504 #endif
505  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3)
506 
507  ! psrf4
508 #ifdef NC_DOUBLE
509  status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42)
510 #else
511  status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42)
512 #endif
513  CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4)
514 
515  DO i = 1, kon
516 
517  psrf(i, 1) = psrf1(i)
518  psrf(i, 2) = psrf2(i)
519  psrf(i, 3) = psrf3(i)
520  ! test abderr
521  ! print*,'Dans read_pstoke psrf3 =',psrf3(i),i
522  psrf(i, 4) = psrf4(i)
523 
524  ftsol(i, 1) = ftsol1(i)
525  ftsol(i, 2) = ftsol2(i)
526  ftsol(i, 3) = ftsol3(i)
527  ftsol(i, 4) = ftsol4(i)
528 
529  END DO
530 
531  END IF
532 
533  RETURN
534 
535 END SUBROUTINE read_pstoke0
536 
mod_grid_phy_lmdz::nbp_lev
integer, save nbp_lev
Definition: mod_grid_phy_lmdz.F90:17
mod_grid_phy_lmdz::nbp_lat
integer, save nbp_lat
Definition: mod_grid_phy_lmdz.F90:16
read_pstoke0
subroutine read_pstoke0(irec, zrec, zkon, zkev, 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_pstoke0.F90:9
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