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