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

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

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