source: LMDZ5/trunk/libf/phylmd/read_pstoke.F90 @ 4672

Last change on this file since 4672 was 2345, checked in by Ehouarn Millour, 9 years ago

Physics/dynamics separation:

  • move test_disvert_m to dynlonlat_phylonlat/phylmd since it is only used by ce0l and relies on dynamics.
  • put "config_inca" in tracinca_mod so physics routines can get the info from there rather than from control_mod.
  • get rid of references to "control_mod" from within the physics.

EM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.6 KB
Line 
1
2! $Id: read_pstoke.F90 2345 2015-08-21 09:57:36Z evignon $
3
4
5
6SUBROUTINE 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
517END SUBROUTINE read_pstoke
518
Note: See TracBrowser for help on using the repository browser.